Listing of file='IDS2PP24' on disk='vmedia/701-2724B.wvd.zip'
# Sector 694, program filename = 'IDS2PP24'
1000 REM "IDS2PP24" - Release 2.1 - PROGRAM GENERATOR - P/F SPECS "Z" DATE OPE
RATIONS
1030 F5$=F1$
: GOSUB 3110
: IF Q=250THEN 2000
: GOSUB 3030
: MAT SEARCH"MMDDYY DDMMYY MMMDDYYDDMMMYYYYDDD DDDDD mmddyy ddmmyy mmmddy
yddmmmyyyyddd ddddd",=F2$TO F9$STEP 7
: E0$()="Verify date in field "&HEX(22)&F1$&HEX(22)&"against "&F2$&" format
"
1056 CONVERT MAX(1,MOD(INT((VAL(F9$,2)+6)/7)-1,6)+1)TO F9$,(#)
: STR(F9$,2)=")"
: E4$()=E4$()&HEX(9A)&"'43("&E8$&")"&HEX(BA9A)&"'56(E$,"&F9$&HEX(BA)
: GOTO 3000
2000 F5$=F2$
: GOSUB 3110
: MAT SEARCH"MMDDYY DDMMYY MMMDDYYDDMMMYYYYDDD DDDDD mmddyy ddmmyy mmmddy
yddmmmyyyyddd ddddd",=F1$TO F9$STEP 7
: Q=MAX(1,INT((VAL(F9$,2)+6)/7))
: CONVERT MOD(Q,6)TO F9$,(#)
: STR(F9$,2)=")"
: IF Q>1AND Q<>7THEN GOSUB 3030
: IF Q>1AND Q<>7THEN E4$()=E4$()&HEX(9A)&"'57("
: ELSE E4$()=E4$()&HEX(9A)&"'45("&E8$&","
2022 IF Q>6THEN E4$()=E4$()&"E4"
: ELSE E4$()=E4$()&"R2"
: IF Q>1AND Q<>7THEN E4$()=E4$()&"$,1,"&F9$&HEX(BA9A)&"'45("&E8$&",E$)"&HEX
(BA)
: ELSE E4$()=E4$()&HEX(2429BA)
2030 AND (STR(F1$,,LEN(F1$)),DF)
: E0$()="Store the"
: IF Q>6THEN E0$()=E0$()&" last used"
: ELSE E0$()=E0$()&" system"
: E0$()=E0$()&" date in field "&HEX(22)&F2$&HEX(22)&" in format "&F1$
3000 IF E2(2)>0THEN E4$()=E4$()&HEX(A2)&E0$()&HEX(BA)
: IF STR(E4$(),LEN(E4$()))=HEX(BA)THEN STR(E4$(),LEN(E4$()))=HEX(1B)
: IF POS(E4$()=BA)>0THEN E$=F0$
: IF E$<>" "THEN STR(F$(),LEN(F$())+1)=E$
: IF E4$()<>" "THEN STR(F$(),LEN(F$())+1)=STR(E4$(),POS(E4$()>20))
: LOAD DA T#2,(D$(13))1000,
3030 E4$()=E4$()&HEX(9F)&"F6$(17)<"&HEX(225E22B1A5405041525422)&"IDS2SUBM"&HEX
(22BA)
: E4$()=E4$()&"E6$=F6$(54)"&HEX(8AD2303129BA)
: E4$()=E4$()&"F6$(54)=F6$(54)"&HEX(8BD2303129BA9F)&"E6$="&HEX(D2)&"00)"
: E4$()=E4$()&HEX(B1A15423322C22)&"IDS2SUB7"&HEX(22FF38002CFF3979B3FFC0C4BA
)
: RETURN
3080 STOP #
: PRINT HEX(06020402000E);AT(23,16);"Compiling BASIC program - Now processi
ng sector";E4-E3+1;
: RETURN
3100 STOP "END IT"
3110 Q=250
: IF F5$=" "THEN 3130
: MAT SEARCHE3$(),=STR(F5$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)
: IF Q<250THEN 3130
: IF VER(F5$,"@TSTFLD#")=8THEN Q=VAL(STR(F5$,8))+203
: MAT SEARCHC8$,=STR(F5$,,8)TO F9$
: IF F9$>HEX(0000)THEN Q=INT((VAL(F9$,2)+7)/8)+260
: IF F5$="@SYSBUF0"THEN Q=269
: IF F5$<"FILE # 1"OR F5$>"FILE # 7"THEN 3130
3120 F5$=STR(C8$,(VAL(STR(F5$,8))-48)*8+1)
: GOTO 3110
3130 DEFFN'71(Q)
: E8$=" "
: $PACK(F=HEX(1006))E8$FROMQ
: E8$=STR(E8$,POS(E8$>20))
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PP24"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"