Listing of file='IDS2PC23' on disk='vmedia/701-2725B.wvd.zip'
# Sector 841, program filename = 'IDS2PC23'
1000 REM 'IDS2PC23'--REPORT CONVERSION--OPERATIONS AND RECORD SELECTION
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: DIM J0$(32)8,J2$(128)8,J3$(128)8,J2$8
: J2$=STR(E$(),2,8)
: DIM C9$19
1060 GOSUB '39(J3$,D1)
: IF Q=2THEN 1080
: STOP "Can't find control file "
: GOTO 1060
1080 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
: E$=STR(J2$(),675,2)
: J3=0
: IF E$=" "THEN 1100
: CONVERT STR(E$,,2)TO J3
: ERRORJ3=0
1100 IF J3=0THEN 1205
: J3=MIN(J3,32)
: MAT SEARCHE1$(),="IDS2fs00"TO F9$STEP 56
: IF F9$>HEX(0000)THEN 1107
: GOSUB '63("Edit file has no","t been opened, operations will be omitted.
EXEC to continue","!")
: GOSUB '34(250)
: IF Q=31THEN 2200
: J3=0
: GOTO 1205
1107 GOSUB '32("IDS2sS20")
: GOSUB '45(1,"Conversion Utility")
: GOSUB '45(3,"Report")
: GOSUB '45(4,"Operation")
: FOR J7=1TO J3
: E$()=" "
: GOSUB '55(5,4)
: GOSUB '45(7,J2$)
: GOSUB '45(8,"OPRTN001")
: GOSUB '55(9,J7)
: GOSUB '45(10,"N")
: E$(78)=BIN(J7+31)
: E1$=STR(J0$(),(J7-1)*8+1,8)
: GOSUB 1250
: GOSUB 1300
: NEXT J7
1205 MAT REDIM E$(24)83
: E$()=" "
: DATA LOAD DA T#3,(E4)E$()
: CONVERT J3TO STR(E$(),157,3),(###)
: DATA SAVE DA T#3,(E4)E$()
: IF J3=0THEN 1500
: MAT REDIM F$(27)83
: F$()=ALL(00)
: E8$="OPRTN001"
: STR(E8$,12)=BIN(J3)&ALL(00)
: ADD(STR(E8$,1,11),E0)
: FOR I=12TO 1STEP -1
: ROTATEC(STR(E8$,I),2)
: NEXT I
: STR(F$(),,9)=STR(E8$,,9)
: MAT REDIM F$(27)83
: DATA SAVE DA T#3,(E4+25)F$()
: GOTO 1500
1250 J6=0
: FOR J5=1TO 8
: E$=STR(E1$,J5,1)
: ON J5-2GOTO 1260,,1260,,1260
: IF STR(E$,,1)>HEX(80)THEN 1255
: J=VAL(E$)
: IF J=0THEN E$=" "
: ELSE E$=J3$(J)
: GOTO 1270
1255 E$=E$AND HEX(0F)
: J=MIN(9,VAL(E$)-1)
: E$=STR(J2$(),140+J*8,8)
: J6=J6+1
: GOSUB '45(J6+12,E$)
: E$="CONSTNTX"
: CONVERT J6TO STR(E$,8,1),(#)
: GOTO 1270
1260 IF VAL(E$)=0THEN E$=" "
: GOTO 1275
1270 IF J5>1THEN 1275
: GOSUB '45(21,E$)
: GOSUB '45(22," ")
: GOTO 1277
1275 GOSUB '45(J5+21,E$)
1277 NEXT J5
: RETURN
1300 FOR I=1TO 9
: C9$=STR(E$(),82,16)&E$(78)&E$(76)&BIN(I+47)
: F6$(14)="N"
: GOSUB '41("IDS2fs00",C9$,.5)
: F$()=" "
: IF Q<>0THEN GOSUB '42("IDS2fs00",0)
: NEXT I
: F6$(14)="Y"
: IF STR(E$(),98)=" "THEN 1410
: FOR I=0TO 1
: F$()=E$(76)&BIN(I+48)&E$(78)&STR(E$(),79,19)
: ON IGOTO 1380
1370 STR(F$(),23)=STR(E$(),98,228)
: GOSUB '42("IDS2fs00",0)
: IF H=0THEN 1410
: GOTO 1400
1380 STR(F$(),23)=STR(E$(),326,228)
: IF STR(F$(),23)<>" "THEN GOSUB '42("IDS2fs00",0)
: IF H=0THEN 1410
1400 NEXT I
: F6$(14)="Y"
1410 RETURN
1500 GOSUB '53("Converting record selection specifications")
: E$=STR(J2$(),220,58)
: STR(E$(),1307,80)=E$
: E$=STR(J2$(),278,58)
: STR(E$(),1387,80)=E$
: STR(E$(),1493,1)="Y"
: E$=STR(E$(),78,8)
1550 IF E$=" "THEN 1610
: E$=E$OR ALL(20)
: GOSUB '39(E$,D4)
: DATA LOAD BA T#P,(A)E4$()
: IF STR(E4$(),13,1)<"5"THEN X=24
: ELSE X=6
: MAT REDIM E3$(X)83
: DATA LOAD DA T#P,(A)E3$()
: STR(E$(),887,120)=" "
: STR(E$(),1007,300)=" "
1560 F0$="ABCDE"
: FOR I=0TO 4
: E$=STR(E3$(),108+I*17,8)
: IF E$=" "THEN 1580
: STR(E$(),872+I,1)="1"
: STR(E$(),887+I*8,8)=E$
: STR(E$(),1007+I*20,20)=E$
: STR(E$(),1486+I,1)=STR(F0$,I+1,1)
1580 NEXT I
1610 STR(E$(),1494,1)="N"
: IF STR(J2$(),336,296)=" "THEN 1770
: F0$="ABCDEFGHIJKLMNO"
: FOR I=0TO 2
: E$=STR(J2$(),336+I*74,8)
: IF E$=" "THEN 1680
1630 MAT SEARCHSTR(E$(),887,120),=STR(E$,,8)TO F9$STEP 8
: IF F9$>HEX(0000)THEN 1640
: E3$=" "
: MAT SEARCHSTR(E$(),887,120),=E3$TO F9$STEP 8
: Q=VAL(F9$,2)
: IF Q>0THEN STR(E$(),886+Q,8),STR(E$(),1007+((Q-1)/8*20),20)=E$
: GOTO 1630
1640 Q=VAL(F9$,2)
: STR(E$(),1468+I*7,1)=STR(F0$,(Q+7)/8,1)
: STR(E$(),1469+I*7,2)=STR(J2$(),344+I*74,2)
: STR(E$(),1471+I*7,1)="V"
: STR(E$(),777+I*20,20)=STR(J2$(),346+I*74,20)
: IF STR(E$(),160,1)="1"THEN STR(E$(),872+(Q-1)/8,1)="1"
1680 NEXT I
: J5=0
: FOR I=0TO 6
: IF STR(E$(),887+I*8,8)=" "THEN 1710
: IF STR(E$(),872+I,1)<>" "THEN 1710
: J5=J5+1
1710 NEXT I
: IF J5=0THEN 1750
: FOR I=2TO 4
: E$=STR(E$(),70+I*8,8)
: IF E$=" "THEN 1745
: E$=E$OR ALL(20)
: GOSUB '39(E$,D4)
: DATA LOAD BA T#P,(A)E4$()
: IF STR(E4$(),13,1)<"5"THEN X=24
: ELSE X=6
: MAT REDIM E3$(X)83
: DATA LOAD DA T#P,(A)E3$()
: IF X=24THEN 1735
: E$=STR(E3$(),82,8)OR ALL(20)
: GOSUB '39(E$,D4)
1735 MAT REDIM E3$(24)83
: DATA LOAD DA T#P,(A+8)E3$()
: FOR J=0TO 6
: IF STR(E$(),872+J,1)<>" "THEN 1740
: E$=STR(E$(),887+J*8,8)
: IF E$=" "THEN 1740
: MAT SEARCHE3$(),=E$TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1740
: CONVERT ITO STR(E$(),872+J,1),(#)
: J5=J5-1
: IF J5>0THEN 1740
: J=6
: I=4
1740 NEXT J
1745 NEXT I
1750 STR(E$(),1494,1)="Y"
1770 E$=STR(J2$(),632,1)
: IF E$=" "THEN Q=0
: ELSE CONVERT STR(E$,,1)TO Q
: ERRORQ=0
1780 F0$="NNNYNNNYNYYN"
: STR(E$(),774,3)=STR(F0$,Q*3+1,3)
: STR(E$(),850,4)="SYSY"
: GOSUB '32("IDS2sR06")
: GOSUB '36
: MAT REDIM E$(E8)1
: IF STR(E$(),774,3)=" "THEN GOSUB '45(28,"No")
: ELSE GOSUB '45(28,"Yes")
: IF STR(E$(),1307,160)=" "THEN GOSUB '45(29,"No")
: ELSE GOSUB '45(29,"Yes")
: E$(1493)=E$
2000 IF E$(774)<>"Y"THEN GOSUB '45(30,"No")
: ELSE GOSUB '45(30,"Yes")
: IF STR(E$(),1468,18)=" "THEN GOSUB '45(31,"No")
: ELSE GOSUB '45(31,"Yes")
: E$(1494)=E$
: IF E$(775)<>"Y"THEN GOSUB '45(32,"No")
: ELSE GOSUB '45(32,"Yes")
: IF STR(E$(),1486,5)=" "THEN GOSUB '45(33,"No")
: ELSE GOSUB '45(33,"Yes")
: IF E$(776)<>"Y"THEN GOSUB '45(34,"No")
: ELSE GOSUB '45(34,"Yes")
2025 GOSUB '37(35)
: IF E$=" "THEN GOSUB '45(35,"SYS")
: GOSUB '37(36)
: IF E$="Y"THEN E$="Yes"
: ELSE E$="No"
: PRINT AT(19,39);E$
: GOSUB '45(24,"Yes")
: GOSUB '45(25,"Yes")
: IF STR(E$(),866,6)=" "THEN GOSUB '45(26,"No")
: ELSE GOSUB '45(26,"Yes")
: IF STR(E$(),848,2)=" 0"THEN GOSUB '45(27,"No")
: ELSE GOSUB '45(27,"Yes")
2100 GOSUB '63("Key EXEC to save"," control file and create report, FN '31 to
CANCEL"," ")
: GOSUB '34(250)
: IF Q=31THEN 2200
: IF Q<>32THEN 2100
: MAT REDIM E$(24)83,F$(27)83,E3$(24)83,E2$(27)83
: DATA LOAD DA T#3,(E4+8)F$()
: DATA LOAD DA T#3,(E4+17)E3$()
: MAT REDIM E$(E8)1,F$(E9)1,E3$(249)8,E2$(249)9
2130 R3$(1)="IDS2CRXX"
: E9$(6)=STR(E$(),2,8)
: C5$="R"
: COM CLEAR D1$
: LOAD T#2,"IDS2PR12"1000,
2200 COM CLEAR E3
: SELECT #3<D9$(3)>
: LOAD T#2,"IDS2PCMN"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PC23"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"