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