SYSTEMROUTINESPEC C CASTOUT(STRINGNAME S) EXTERNALROUTINESPEC C DESTROY(STRING (255) S) EXTERNALROUTINESPEC C DETACH(STRING (255) S) EXTERNALROUTINESPEC C DISCONNECT(STRING (255) S) EXTERNALINTEGERFNSPEC C DMESSAGE(STRING (6) USER, INTEGERNAME LEN, INTEGER ACT,FSYS,ADR) SYSTEMSTRINGFNSPEC C FAILUREMESSAGE(INTEGER FLAG) SYSTEMSTRINGFNSPEC C ITOS(INTEGER N) SYSTEMROUTINESPEC C MOVE(INTEGER LEN,FROM,TO) SYSTEMROUTINESPEC C OUTFILE(STRING (31)S, INTEGER SIZE,MAXBYTES,PROT, INTEGERNAME CONAD,FLAG) SYSTEMINTEGERFNSPEC C PSTOI(STRING (63)S) SYSTEMSTRINGFNSPEC C SETFNAME(STRING (40) NAME) EXTERNALINTEGERFNSPEC C UINFI(INTEGER I) EXTERNALSTRINGFNSPEC C UINFS(INTEGER I) ! ! ! INTEGERFN TEXTTOFILE(STRING (255)TEXT, FILE) INTEGER CONAD, FLAG, L OUTFILE(FILE,4096,4096,0,CONAD,FLAG) IF FLAG = 0 START L = LENGTH(TEXT) MOVE(L,ADDR(TEXT)+1,CONAD+32) INTEGER(CONAD)=L+32 INTEGER(CONAD+4)=32 FINISH RESULT =FLAG END ; ! TEXTTOFILE ! ! ! INTEGERFN DAY NO CONSTLONGINTEGER JMS = X'141DD76000' *RRTC_0 *USH_-1 *SHS_1 *USH_1 *IDV_JMS *STUH_B *EXIT_-64 END ! ! ! ROUTINE KDATE(INTEGERNAME D,M,Y,INTEGER K) ! K IS DAYS SINCE 1ST JAN 1900 ! RETURNS D, M, Y 2 DIGIT Y ONLY ! %INTEGER W ! K=K+693902; ! days since Cleopatras birthday ! W=4*K-1 ! Y=W//146097 ! K=W-146097*Y ! D=K//4 ! K=(4*D+3)//1461 ! D=4*D+3-1461*K ! D=(D+4)//4 ! M=(5*D-3)//153 ! D=5*D-3-153*M ! D=(D+5)//5 ! Y=K *LSS_K; *IAD_693902 *IMY_4; *ISB_1; *IMDV_146097 *LSS_TOS ; *IDV_4; *IMY_4; *IAD_3 *IMDV_1461; *ST_(Y) *LSS_TOS ; *IAD_4; *IDV_4 *IMY_5; *ISB_3; *IMDV_153 *ST_(M); *LSS_TOS *IAD_5; *IDV_5; *ST_(D) IF M<10 THEN M=M+3 ELSE START M=M-9 IF Y=99 THEN Y = 0 ELSE Y=Y+1 FINISH END ; ! OF KDATE ! ! ! !%INTEGERFN KDAY(%INTEGER D,M,Y) ! %IF M>2 %THEN M=M-3 %ELSE M=M+9 %AND Y=Y-1 ! %RESULT=1461*Y//4+(153*M+2)//5+D+58 !%END; ! OF KDAY ! ! ! STRING (255)FN DATE(INTEGER K) INTEGER D, M, Y, Q, R STRING (2)TH CONSTSTRING (6)ARRAY DAY(0:6) = "Mon", "Tues", "Wednes", "Thurs", C "Fri", "Satur", "Sun" CONSTSTRING (3)ARRAY MON(1:12) = "Jan", "Feb", "Mar", "Apr", C "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" CONSTSTRING (2)ARRAY ORD(1:3) = "st", "nd", "rd" KDATE(D, M, Y, K) K = K - 7 * (K//7); ! day of week Q = D//10 R = D - 10 * Q TH = "th" TH = ORD(R) IF Q # 1 AND 1 <= R <= 3 RESULT = DAY(K)."day ".ITOS(D).TH." ".MON(M).", 19".ITOS(Y) END ! ! ! STRINGFN S2(INTEGER I); ! returns a 2-digit string INTEGER TENS RESULT = "??" UNLESS 0 < I < 100 TENS = I // 10 I = I - 10 * TENS RESULT = TOSTRING(TENS+'0').TOSTRING(I+'0') END ! ! ! STRING (8)FN NEXTDATE(INTEGER INTERVAL) INTEGER D, M, Y KDATE(D, M, Y, DAYNO+INTERVAL) RESULT = S2(D)."/".S2(M)."/".S2(Y) END ; ! NEXTDATE ! ! ! ROUTINE AUTO(STRING (255) COMMANDS, INTEGER INTERVAL, TIME LIMIT, INTEGERNAME FLAG) ! ! ! INTEGER LEN STRING (255) DETCOM STRING (127) CONFIRM STRING (8) NEWDATE STRING (40) FAIL CONSTSTRING (7) NJOB="T#AUTOJ" CONSTSTRING (5) DETFILE="T#DTF" ! ! ! NEWDATE = NEXTDATE(INTERVAL); ! get date 'interval' days from today DETCOM = "AFTER=" . NEWDATE . " .END " FLAG = TEXT TO FILE(DETCOM, DETFILE) UNLESS FLAG = 0 START FAIL=SETFNAME("AUTO fails to create ".DETFILE." - ") PRINTSTRING(FAIL.FAILUREMESSAGE(FLAG)) RETURN FINISH ! FLAG = TEXT TO FILE(COMMANDS, NJOB) UNLESS FLAG = 0 START FAIL=SETFNAME("AUTO fails to create ".NJOB." - ") PRINTSTRING(FAIL.FAILUREMESSAGE(FLAG)) RETURN FINISH ! DETACH(NJOB.",".ITOS(TIME LIMIT).",".DETFILE) ! CONFIRM="Job detached to run on ".DATE(DAYNO+INTERVAL).TOSTRING(10) IF UINFI(2) = 1 {foreground} C THEN PRINTSTRING(CONFIRM) C ELSE START LEN=LENGTH(CONFIRM) FLAG=DMESSAGE(UINFS(1),LEN,1,UINFI(1),ADDR(CONFIRM)+1) FINISH ! DISCONNECT(DETFILE) DISCONNECT(NJOB) DESTROY(DETFILE) DESTROY(NJOB) END ; ! AUTO ! ! ! EXTERNALROUTINE RUNAUTO(STRING (255)COMMAND) INTEGER FLAG, INTERVAL, TIME LIMIT STRING (255)W1, W2 CASTOUT(COMMAND) W1 = "1" UNLESS COMMAND -> COMMAND . (",") . W1 W2 = "10" UNLESS W1 -> W1 . (",") . W2 INTERVAL = PSTOI(W1) TIME LIMIT = PSTOI(W2) AUTO(COMMAND.TOSTRING(10), INTERVAL, TIME LIMIT, FLAG) PRINTSTRING("FLAG IS") WRITE(FLAG, 1) END ; ! RUNAUTO ENDOFFILE