Listing of file='IPL-DATE' on disk='vmedia/701-2047D.wvd.zip'
# Sector 48, program filename = 'IPL-DATE'
0010 REM IPL-DATE,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0060 COM Q1$8,Q1,S,S1
: DIM Q6$64,W$8,W3$3,W4$1,W$(3)8,Q4(3),Q5(3)
: DIM U9$8,U8$64
: DATA LOAD DC OPEN T#0,"MEMORY"
: DATA LOAD DC S,Q1$,Q1,S1
: DATA SAVE DC CLOSEALL
: PRINT HEX(03)
: GOSUB '220("ENTER TODAY'S DATE AS MM/DD/YY.")
: Q1$=U9$
: Q1=U9
0200 DATA LOAD DC OPEN T#0,"MEMORY"
: DATA SAVE DC #0,S,Q1$,Q1,S1
: DATA SAVE DC CLOSEALL
: LOAD DC T#0,"START"
0290 DEFFN'220(U8$)
0300 GOSUB '243(U8$,8)
: GOSUB '221(Q6$)
: IF Q6$="E"THEN 300
: GOSUB '223(U9)
: GOSUB '248(1,0,3)
: PRINT "IS DATE OK? (Y/N)",U9$,U9
0360 GOSUB '244(1)
: IF Q6$="N"THEN 290
: IF Q6$<>"Y"THEN 360
: RETURN
0410 DEFFN'221(Q6$)
: U9$=Q6$
: IF Q6$=" "THEN 750
: IF POS(Q6$="/")-1<>NUM(Q6$)THEN 750
: CONVERT STR(Q6$,1,NUM(Q6$))TO U8
: IF U8<1THEN 750
: IF U8>12THEN 750
: STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
: IF POS(Q6$="/")-1<>NUM(Q6$)THEN 750
: CONVERT STR(Q6$,1,NUM(Q6$))TO U6
0520 IF U6<1THEN 750
: IF U6>31THEN 750
: STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
: IF NUM(Q6$)<>64THEN 750
: CONVERT Q6$TO U0
: U7=(1-SGN(U0-INT(U0/4)*4))*SGN((U8-1)*(U8-2))
: ON U8GOTO 720,700,690,680,670,660,650,640,630,620,610,600
0600 U7=U7+30
0610 U7=U7+31
0620 U7=U7+30
0630 U7=U7+31
0640 U7=U7+31
0650 U7=U7+30
0660 U7=U7+31
0670 U7=U7+30
0680 U7=U7+31
0690 U7=U7+28
0700 U7=U7+31
0720 U9=U7+U6+U0*1000
: RETURN
0750 Q6$="E"
: RETURN
0780 DEFFN'222(U8$)
: GOSUB '245(U8$,5,0)
: GOSUB '223(Q9)
: GOSUB '221(U9$)
: GOSUB '248(1,0,3)
: PRINT "IS DATE OK? (Y/N)",U9$,U9
0840 GOSUB '244(1)
: IF Q6$="N"THEN 780
: IF Q6$<>"Y"THEN 840
: RETURN
0890 DEFFN'223(U9)
: U1=INT(U9/1E3)
: U2=U9-U1*1E3
: U3=1-SGN(U1-INT(U1/4)*4)
: IF U2<=334+U3THEN 1010
: U4=U2-334-U3
: U5=12
: GOTO 1540
1010 IF U2<=304+U3THEN 1060
: U4=U2-304-U3
: U5=11
: GOTO 1540
1060 IF U2<=273+U3THEN 1110
: U4=U2-273-U3
: U5=10
: GOTO 1540
1110 IF U2<=243+U3THEN 1160
: U4=U2-243-U3
: U5=9
: GOTO 1540
1160 IF U2<=212+U3THEN 1210
: U4=U2-212-U3
: U5=8
: GOTO 1540
1210 IF U2<=181+U3THEN 1260
: U4=U2-181-U3
: U5=7
: GOTO 1540
1260 IF U2<=151+U3THEN 1310
: U4=U2-151-U3
: U5=6
: GOTO 1540
1310 IF U2<=120+U3THEN 1360
: U4=U2-120-U3
: U5=5
: GOTO 1540
1360 IF U2<=90+U3THEN 1410
: U4=U2-90-U3
: U5=4
: GOTO 1540
1410 IF U2<=59+U3THEN 1460
: U4=U2-59-U3
: U5=3
: GOTO 1540
1460 IF U2<=31THEN 1510
: U4=U2-31
: U5=2
: GOTO 1540
1510 U4=U2
: U5=1
1540 CONVERT U5TO STR(U9$,1,2),(##)
: CONVERT U4TO STR(U9$,4,2),(##)
: CONVERT U1TO STR(U9$,7,2),(##)
: STR(U9$,3,1),STR(U9$,6,1)="/"
: RETURN
1600 DEFFN'224(Q9)
: U2=INT(365.25*(INT(Q9/1E3)-1))+Q9-INT(Q9/1E3)*1E3
: Q9=INT((U2)/365.25)
: Q9=Q9*1E3+(U2-INT(365.25*Q9))+1E3
: RETURN
1660 DEFFN'225(U1,U2)
: U3=INT(365.25*(INT(U2/1E3)-1))+U2-INT(U2/1E3)*1E3
: U3=U3-(INT(365.25*(INT(U1/1E3)-1))+U1-INT(U1/1E3)*1E3)
: RETURN
1710 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 1760
: IF W0=1THEN 1750
: STR(Q6$,2)=STR(Q6$,1,W0-1)
1750 PRINT Q6$;
1760 RETURN
1780 DEFFN'243(Q6$,Q0)
: GOSUB 2230
1800 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 2300
: IF LEN(Q6$)<=Q0THEN 2300
: GOSUB 2200
1870 DEFFN'244(Q0)
: GOSUB 2280
: GOSUB 2250
: GOTO 1800
1920 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2230
1950 IF ABS(Q2)+ABS(Q3)=0THEN 1990
: GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOTO 2000
1990 PRINT ,," "
2000 GOSUB 2280
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 2080
: IF ABS(Q2)+Q3=0THEN 2180
: IF Q9>=0THEN 2150
: IF Q2<=0THEN 2150
2080 GOSUB 2200
2100 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 2280
: GOSUB 2250
: GOTO 1950
2150 IF ABS(Q9)>=10^ABS(Q2)THEN 2080
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 2080
2180 GOSUB '248(3,0,1)
: RETURN
2200 GOSUB '248(3,0,1)
: PRINT "RE-ENTER"
: RETURN
2230 SELECT PRINT 005(64),CO 005
: PRINT HEX(010A);STR(Q6$,1);
2250 SELECT PRINT 005(64),CO 005
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
2280 PRINT HEX(010A0A)
: RETURN
2300 PRINT HEX(0A);TAB(64)
: SELECT PRINT 005(64),CO 005
: RETURN
2340 DEFFN'248(Q6,Q7,Q8)
: GOSUB 2480
: IF Q8<1THEN 2450
: GOSUB 2450
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 2450
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
2450 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
2480 SELECT PRINT 005(64),CO 005
: RETURN