image of READY prompt

Wang2200.org

Listing of file='IDS2PC21' on disk='vmedia/701-2725B.wvd.zip'

# Sector 805, program filename = 'IDS2PC21'
1000 REM 'IDS2PC21'--REPORT CONVERSION --CREATE NEW MASK
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : COM F3
   : DIM J1$(86)62,J2$(128)8,J3$(128)8,J4$(128)8,J0$(32)8,F4$(99)8
   : PRINT HEX(03);AT(10,22);BOX(3,35);AT(11,22);HEX(02040200);"     Creating
     new report mask";HEX(0F06);
1050 GOSUB '39(J3$,D1)
   : IF Q=2THEN 1060
   : STOP "Can't find control file !!!"
   : GOTO 1050
1060 J2,F8=A
   : FOR I=1TO 513STEP 256
   : DATA LOAD BA T#D1,(J2,J2)STR(J2$(),I,256)
   : NEXT I
   : DATA LOAD BA T#D1,(J2,J2)J0$()
   : FOR I=1TO 769STEP 256
   : DATA LOAD BA T#D1,(J2,J2)STR(J3$(),I,256)
   : NEXT I
   : FOR I=1TO 769STEP 256
   : DATA LOAD BA T#D1,(J2,J2)STR(J4$(),I,256)
   : NEXT I
   : DATA LOAD DA T#D1,(J2,J2)J1$()
   : CONVERT STR(J2$(),81,3)TO C1
   : CONVERT STR(J2$(),84,2)TO F4
   : IF F4=0THEN 2560
1090 FOR I=1TO INT(86*62/C1)
   : CONVERT ITO STR(F4$(I),,2),(##)
   : STR(F4$(I),3,2)="00"
   : STR(F4$(I),7,2)="  "
   : NEXT I
   : IF STR(J1$(),,C1)=" "THEN 1120
   : STR(F4$(1),5,2)="HP"
1120 CONVERT STR(J2$(),635,2)TO F5
   : CONVERT STR(J2$(),637,2)TO F6
   : IF F5=0THEN 1130
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="H1"
   : NEXT I
1130 CONVERT STR(J2$(),639,2)TO F5
   : CONVERT STR(J2$(),641,2)TO F6
   : IF F5=0THEN 1140
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="H0"
   : NEXT I
1140 CONVERT STR(J2$(),643,2)TO F5
   : CONVERT STR(J2$(),645,2)TO F6
   : IF F5=0THEN 1150
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="D "
   : NEXT I
1150 CONVERT STR(J2$(),647,2)TO F5
   : CONVERT STR(J2$(),649,2)TO F6
   : IF F5=0THEN 1160
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="F0"
   : NEXT I
1160 CONVERT STR(J2$(),651,2)TO F5
   : CONVERT STR(J2$(),653,2)TO F6
   : IF F5=0THEN 1170
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="F1"
   : NEXT I
1170 CONVERT STR(J2$(),655,2)TO F5
   : CONVERT STR(J2$(),657,2)TO F6
   : IF F5=0THEN 1180
   : FOR I=F5TO F6
   : STR(F4$(I),5,2)="FR"
   : NEXT I
1180 F6=INT(86*62/C1)
   : F5=F6-1
   : IF STR(J1$(),(F5-1)*C1+1,C1)=" "THEN 1190
   : STR(F4$(F5),5,2)="FP"
1190 IF STR(J1$(),F5*C1+1,C1)=" "THEN 1200
   : STR(F4$(F6),5,2)="FP"
1200 F3=LEN(J1$())/C1
   : IF F3>INT(F3)THEN F3=F3+1
   : F3=INT(F3)
   : J5=0
   : FOR I=F6TO F3STEP -1
   : IF STR(F4$(I),5,4)<>" "THEN J5=MAX(J5,I)
   : NEXT I
   : J=0
   : FOR I=1TO MAX(F3,J5)
   : IF STR(F4$(I),5)<>" "AND STR(J1$(),(I-1)*C1+1,MIN(C1,LEN(STR(J1$(),1))-((
     I-1)*C1+1)))<>" "THEN J=J+1
   : NEXT I
   : CONVERT JTO STR(E$(),155,2),(##)
1220 J5=0
   : FOR I=1TO F3
   : E$=F4$(I)
   : $TRAN(E$," 0")R
   : IF STR(E$,3)<>" "THEN J5=J5+1
   : NEXT I
   : CONVERT J5TO STR(E$(),854,2),(##)
   : FOR I=F3+1TO F6
   : F4$(I)=" "
   : NEXT I
   : F5$="IDS2wS"
   : CONVERT R0TO STR(F5$,7),(##)
2130 LIMITS T#3,F5$,A,B,C,D
   : IF D=2THEN 2150
   : DATA SAVE DC OPEN T#3,(186)F5$
   : ERRORGOSUB '35("Not enough room for work file -- FN '31tocancel")
   : GOSUB '34(250)
   : GOTO 2540
2145 DSKIP #3,184S
   : DATA SAVE DC #3,END
   : GOTO 2130
2150 E4=A
   : $TRAN(J1$(),HEX(208B))R
   : F7=0
   : FOR I=1TO F3
   : E4$()=STR(F4$(I),,8)&STR(J1$(),(I-1)*C1+1,MIN(C1,LEN(STR(J1$(),1))-((I-1)
     *C1+1)))&ALL(20)
   : F7=MAX(F7,LEN(E4$()))
   : DATA SAVE BA T#3,(E4+33+I)E4$()
   : NEXT I
   : F7=MAX(F7-8,0)
   : CONVERT F7TO STR(E$(),845,3),(###)
   : E4$()=" "
   : FOR I=F3+1TO 99
   : CONVERT ITO STR(E4$(),,2),(##)
2240 DATA SAVE BA T#3,(E4+33+I)E4$()
   : NEXT I
   : PRINT HEX(0202000F);
   : LOAD T#2,"IDS2PC22"1000,
2540 COM CLEAR E3
   : SELECT #3<D9$(3)>
   : LOAD T#2,"IDS2PCMN"1000,
2560 STOP "NO LINES IN REPORT"
   : GOTO 2560
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PC21"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"