10  COM N$[7],R,D$[45]
20  N$="TSTDAT"
30  R=60
40  D$="TWMDYPN"
50  CHAIN "SYSDAT"
60  REM RET RUNH< HERE WITH DATE
70  PRINT D$
80  PRINT R
90  END 
100  REM
110  REM  VERSION 2, 19 APRIL 1973 BY DICK RANDS, BAEDP TIMESHARE SERVICE
120  REM *************************************************************
130  REM
140  REM    A UTILITY SUBROUTINE WHICH WILL PROVIDE THE CALLING
150  REM    PROGRAM WITH THE CURRENT SYSTEM DATE, THE TIME OF DAY,
160  REM    THE DAY OF THE WEEK, THE USER'S PORT NUMBER, AND A
170  REM    NUMERIC DATE IN ANY DESIRED ORDER.  THE CALLING PROGRAM
180  REM    MUST PASS ITS PROGRAM NAME, THE RETURNING STATEMENT NUMBER,
190  REM    AND THE DESIRED DATE FORMAT CODES IN THAT ORDER.  THE
200  REM    THE CALLING PROGRAM MUST BEGIN WITH A COM STATEMENT IN THE
210  REM    FOLLOWING FORMAT:   10 COM N$(7),R,D$(45)
220  REM    AND MUST CONTAIN THE FOLLOWING SEQUENCE:
230  REM        20 N$="YOUR PROGRAM NAME"
240  REM        30 R=RETURNING STATEMENT NUMBER (EX. 60)
250  REM        40 D$="DATE FORMAT CODES" (EX. "DMYN")
260  REM        50 CHAIN "$SYSDAT"
270  REM        60 REM  RETURN HERE WITH DATE IN R AND D$
280  REM
290  REM    SYSDAT WILL RETURN WITH THE FORATTED DATA IN D$ AND/OR THE
300  REM    NUMERIC DATE IN R.  THE DATE FORMAT REQUIRES THE USE OF THE
310  REM    FOLLOWING CODES:
320  REM       M = MONTH (JANUARY, FEBRUARY, ETC.)
330  REM       D = DAY OF THE MONTH (1-31)
340  REM       Y = YEAR (1972, 1973, ETC.)
350  REM       W = DAY OF THE WEEK (SUNDAY, MONDAY, ETC.)
360  REM       T = TIME OF DAY (5:06 PM)
370  REM       P = PORT NUMBER (PORT #3)
380  REM       N = NUMERIC DATE (IN YYMMDD FORMAT)
390  REM
400  REM
410  REM   FOR EXAMPLE, IF YOU PASS "DMY" THEN YOU WILL RECIEVE
420  REM       23 AUGUST 1972
430  REM
440  REM   OR, IF YOU PASS "TWMDYN" YOU WILL RECEIVE
450  REM       4:07 PM WEDNESDAY AUGUST 23, 1972
460  REM   WITH 720823 AS THE NUMERIC VALUE IN R
470  REM
480  REM
490  DIM T$[7],M$[9],A$[10],H$[7],Q[12]
500  D9=K=0
510  IF LEN(D$)=0 THEN 1730
520  T$="MDYWTPN"
530  A$="0123456789"
540  H$=D$[1,7]
550  R1=R
560  D$=""
570  FOR I=1 TO LEN(H$)
580  IF K<45 THEN 620
590  PRINT "FORMAT EXCEEDS CAPACITY.  FORMAT TERMINATED AND"
600  PRINT "RETURNED TO CALLING PROGRAM."
610  GOTO 1730
620  FOR J=1 TO 7
630  IF H$[I,I]=T$[J,J] THEN 680
640  NEXT J
650  PRINT "INVALID FORMAT CODE = ";H$[I,I];".  FORMAT TERMINATED"
660  PRINT "AND RETURNED TO CALLING PROGRAM."
670  GOTO 1730
680  GOTO J OF 700,830,1010,1070,1170,1320,1390
690  GOTO 650
700  IF D9#0 THEN 720
710  GOSUB 1430
720  K=K+1
730  RESTORE 800
740  FOR L=1 TO M
750  READ M$
760  NEXT L
770  D$[K,K+LEN(M$)-1]=M$
780  K=K+LEN(M$)-1
790  GOTO 1700
800  DATA "JANUARY","FEBRUARY","MARCH","APRIL"
810  DATA "MAY","JUNE","JULY","AUGUST"
820  DATA "SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"
830  IF D9#0 THEN 850
840  GOSUB 1430
850  B=D
860  GOSUB 910
870  IF H$[I+1,I+1]#"Y" THEN 900
880  K=K+1
890  D$[K,K]=","
900  GOTO 1700
910  REM TWO DIGIT NUMBER TO STRING ROUTINE
920  K=K+1
930  D1=INT(B/10)
940  IF J=5 AND D1=0 THEN 970
950  IF D1=0 THEN 980
960  D$[K,K]=A$[D1+1,D1+1]
970  K=K+1
980  D2=B-INT(B/10)*10
990  D$[K,K]=A$[D2+1,D2+1]
1000  RETURN 
1010  B=TIM(3)
1020  K=K+1
1030  D$[K,K+1]="19"
1040  K=K+1
1050  GOSUB 910
1060  GOTO 1700
1070  K=K+1
1080  T=(TIM(2)+365*TIM(3)+INT((TIM(3)-1)/4+.01))/7
1090  T=INT(7*(T-INT(T))+1.5)
1100  RESTORE 1140
1110  FOR L=1 TO T
1120  READ M$
1130  NEXT L
1140  DATA "SUNDAY","MONDAY","TUESDAY","WEDNESDAY"
1150  DATA "THURSDAY","FRIDAY","SATURDAY"
1160  GOTO 770
1170  K=K+1
1180  H=TIM(1)
1190  IF H <= 12 THEN 1230
1200  D$[K,K+7]="  :0  PM"
1210  H=H-12
1220  GOTO 1240
1230  D$[K,K+7]="  :0  AM"
1240  B=H
1250  K=K-1
1260  GOSUB 910
1270  K=K+1
1280  B=TIM(0)
1290  GOSUB 910
1300  K=K+3
1310  GOTO 1700
1320  K=K+1
1330  ENTER #P
1340  D$[K,K+5]="PORT #"
1350  K=K+5
1360  B=P
1370  GOSUB 910
1380  GOTO 1700
1390  IF D9#0 THEN 1410
1400  GOSUB 1430
1410  R=Y*10^4+M*100+D
1420  GOTO 1720
1430  REM  COMPUTE MONTH AND DAY NUMBERS
1440  L=0
1450  D9=1
1460  Y=TIM(3)
1470  FOR S=1 TO 8
1480  IF Y=68+S*4 THEN 1510
1490  IF Y<68+S*4 THEN 1520
1500  NEXT S
1510  L=1
1520  Q[1]=31
1530  RESTORE 1580
1540  FOR S=2 TO 12
1550  READ S1
1560  Q[S]=S1+L
1570  NEXT S
1580  DATA 59,90,120,151,181,212,243,273,304,334,365
1590  D=TIM(2)
1600  FOR M=1 TO 12
1610  IF D <= Q[M] THEN 1670
1620  NEXT M
1630  Y=Y+1
1640  M=1
1650  D=D-365
1660  GOTO 1690
1670  IF M=1 THEN 1690
1680  D=D-Q[M-1]
1690  RETURN 
1700  K=K+1
1710  D$[K,K]=" "
1720  NEXT I
1730  CHAIN N$,R1
1740  END 
