image of READY prompt

Wang2200.org

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

# Sector 771, program filename = 'IDS2PC19'
1000 REM 'IDS2PC19'--REPORT CONVERSION-- REPORT LEVEL SPECIFICATIONS
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : COM J3$8,J4$8,F1,F2,D3$2,J9$(4)8,C2$(4)8
   : J3$=F1$OR ALL(20)
   : J4$=F2$OR ALL(20)
   : E$()="\F2"&STR(F2$,,8)
   : SELECT #3<C2$>
   : GOSUB '32("IDS2sR00")
   : F6$(11)="N"
   : DIM F1(8),F2$(6)83,E1(4)
   : J2=0
   : GOSUB '37(1)
   : F$()=ALL(00)
   : J2=1
   : STR(E$(),10)=J4$
1190 STR(E$(),50,12)="   "&STR(R2$,1,6)&STR(R4$,1,3)
   : E1(1)=256
   : E1(2)=1750
   : E1(3),E1(4)=0
   : STR(E$(),150)=HEX(0000)&"  0 0  001750 256N55N"
   : STR(E$(),845,5)="  0 0"
   : STR(E$(),872)=HEX(00)
   : STR(E$(),70,8)="0   0   "
   : FOR I=2TO 18
   : GOSUB '37(I)
   : NEXT I
1550 MAT REDIM F$(128)8
   : GOSUB '39(J3$,D1)
   : IF Q=2THEN 1555
   : GOSUB '35("IDEAS1 control file is not available -- key FN '31 to CANCEL")
   : GOSUB '34(250)
   : IF Q=31THEN 1580
   : GOTO 1550
1555 FOR I=0TO 2
   : DATA LOAD BA T#P,(A+I)STR(F$(),I*256+1,256)
   : NEXT I
   : J9$(1)=STR(F$(),73,8)
   : FOR I=0TO 2
   : J9$(I+2)=STR(F$(),I*16+92,8)
   : NEXT I
1570 GOSUB '39("IDS2fC00",2)
   : IF Q=2THEN 1590
   : GOSUB '63("New data file na","mes are not available from system file; sel
     ect '31 to Cancel","!")
   : GOSUB '34(250)
   : IF Q=31THEN 1580
   : ELSE GOTO 1570
1580 COM CLEAR E3
   : SELECT #3<D9$(3)>
   : LOAD T"IDS2PCMN"1000,
1590 E4$()=" "
   : DATA LOAD BA T#P,(A)STR(E4$(),,256)
   : CONVERT STR(E4$(),41,3)TO D5
   : IF D5>256THEN D5=256
   : D6=INT((D5-1)/16)+1
   : IF D6=0THEN 1670
   : FOR I=1TO D6
   : DATA LOAD BA T#P,(A+I)STR(E4$(),,256)
   : FOR J=1TO 4
   : IF J9$(J)=" "THEN 1630
   : MAT SEARCHE4$(),=J9$(J)TO F9$STEP 16
   : IF F9$=HEX(0000)THEN 1630
   : C2$(J)=STR(E4$(),VAL(F9$,2)+8,8)
1630 NEXT J
   : NEXT I
1670 FOR J=1TO 4
   : IF J9$(J)=" "THEN 1770
   : IF C2$(J)<>" "THEN 1750
   : PRINT HEX(030F)
   : PRINT AT(6,23);BOX(1,34);AT(6,24);HEX(0E);"Data File Has Not Been Convert
     ed ";
   : PRINT AT(10,23);BOX(1,34);AT(10,26);"IDEAS1 Data File is: ";J9$(J);
   : PRINT AT(13,20);BOX(3,40);AT(13,21);"NOTE: After converting all Data File
     s,";
1690 PRINT AT(14,21);"you will be able to create this report";AT(15,21);"with
     all the necessary data files.";
   : GOSUB '53("     Key EXEC to Continue")
   : GOSUB '34(250)
   : GOTO 1580
1750 J4$=C2$(J)OR ALL(20)
   : GOSUB '39(J4$,D4)
   : IF Q<2THEN 1765
   : MAT REDIM E3$(3)83
   : DATA LOAD DA T#D4,(A)E3$()
   : MAT REDIM E3$(249)8
   : GOSUB '45(J*2+17,C2$(J))
   : GOSUB '45(J*2+18,STR(E3$(),22,32))
   : IF J>1THEN 1770
   : K=0
   : FOR I=1TO 5
   : IF STR(E3$(),108+(I-1)*17,8)<>" "THEN K=K+1
   : NEXT I
   : J9=K
   : GOTO 1770
1765 F0$="Control file for "&C2$(J)&" not found -- key FN '31 to CANCEL"
   : GOSUB '35(F0$)
   : GOSUB '34(250)
   : GOTO 1580
1770 NEXT J
   : FOR I=1TO 7
   : GOSUB '71(I)
   : NEXT I
   : Y=0
   : FOR I=78TO 126STEP 8
   : IF STR(E$(),I,8)<>" "THEN Y=Y+1
   : NEXT I
   : GOSUB '55(38,Y)
   : FOR I=35TO 43
   : GOSUB '37(I)
   : NEXT I
   : GOSUB '55(39,E1(2))
   : GOSUB '55(40,E1(1))
   : GOSUB 2530
   : GOTO 2120
2000 F=0
2010 F=F+1
   : IF F>19THEN 2120
2030 J2=1
   : GOSUB '34(F)
   : IF F<13THEN 2010
   : ON F-12GOTO 2080,2100,2010,2080,2010,2010,2110
   : IF F<32THEN 2110
2080 IF VER(E$,"H")=1THEN 2010
   : GOSUB '38(41," ")
   : GOTO 2030
2100 IF E$=" "OR E$=R4$THEN 2010
   : GOSUB '35("User ID (if used) must be current user's")
   : GOTO 2030
2110 GOSUB '71(INT(F/2-8))
   : GOTO 2120
2120 GOSUB '63("EXEC=Accept  EDI","T=Modify top boxes  '31=Cancel"," ")
   : GOSUB '34(250)
   : IF Q=33THEN J2=1
   : IF Q=33THEN 2000
   : IF Q=8OR Q=10THEN 2210
   : IF Q=9THEN 2260
   : IF Q=32THEN 2590
   : IF Q=31THEN 1580
   : PRINT HEX(07);
   : GOTO 2120
2200 STR(F6$(),12,2)="NN"
   : F=Q*2+17
   : GOTO 2030
2210 F=Q+33
   : IF Q<>8THEN 2220
   : PRINT HEX(07);
   : GOTO 2120
2220 J2=1
   : GOSUB '43(F)
   : IF E$="N"THEN GOSUB '45(F,"Y")
   : ELSE GOSUB '45(F,"N")
   : GOTO 2120
2260 F=42
   : GOTO 2030
2280 DEFFN'71(X)
   : GOSUB '43(X*2+17)
   : IF E$<>" "THEN 2350
   : GOSUB '45(X*2+18," ")
   : IF X>1THEN STR(E$(),I*45+89,45),E$(I+864),E$(I+171)=" "
   : F1(X)=0
   : GOTO 2530
2350 F5$=E$OR ALL(20)
   : GOSUB '39(F5$,D4)
   : IF Q=2THEN 2410
   : GOSUB '45(X*2+18," ")
2390 GOSUB '35("Specified file is not an IDEAS data file")
   : RETURN CLEAR
   : GOTO 2030
2410 DATA LOAD BA T#P,(A)STR(F2$(),1,256)
   : IF STR(F2$(),1,4)<>HEX(8201D3E3)THEN 2390
   : DATA LOAD DA T#P,(A)F2$()
   : IF X=1THEN 2450
   : J7=0
   : FOR K=108TO 176STEP 17
   : IF STR(F2$(),K,8)<>" "THEN J7=J7+1
   : NEXT K
   : CONVERT J7TO E$(X+171),(#)
2450 GOSUB '37(X*2+17)
   : GOSUB '45(X*2+18,STR(F2$(),22,32))
   : IF STR(F2$(),10,1)<"5"THEN 2510
   : F5$=STR(F2$(),82)OR ALL(20)
   : GOSUB '39(F5$,D4)
   : DATA LOAD DA T#P,(A)F2$()
2510 CONVERT STR(F2$(),93,4)TO F1(X)
   : F1(X)=MAX(F1(X),VAL(STR(F2$(),418)))
2530 J8=F1(8)
   : F1(8)=0
   : GOSUB '55(40,MAX(256,F1()))
   : FOR J=1TO 7
   : F1(8)=F1(8)+F1(J)
   : NEXT J
   : F1(8)=MIN(9999,MAX(J8,1750))
   : GOSUB '55(39,F1(8))
   : RETURN
2590 Q=J2
   : CONVERT J9TO STR(E$(),151,1),(#)
   : GOSUB '43(4)
   : IF E$=" "THEN Q=-1
   : GOSUB '55(4,Q+1)
   : F5$="IDS2wS"
   : CONVERT R0TO STR(F5$,7),(##)
   : LIMITS T#3,F5$,A,B,C,D
   : IF D=0THEN DATA SAVE DC OPEN T#3,(186)F5$
   : ELSE DATA LOAD DC OPEN T#3,F5$
   : DSKIP #3,184S
   : DATA SAVE DC #3,END
   : DBACKSPACE #3,BEG
   : DATA LOAD DC OPEN T#3,F5$
   : MAT REDIM E$(18)83
   : DATA SAVE DC #3,E$()
   : MAT REDIM E$(E8)1
   : X=1600
2840 STR(E$(),X+1,64)="0001"&ALL(30)
   : CONVERT XTO STR(E$(),X+5,4),(####)
   : FOR I=8TO 2STEP -1
   : F1(I)=F1(I-1)
   : NEXT I
   : F1(1)=1
   : FOR I=2TO 8
   : F1(I)=F1(I)+F1(I-1)
   : NEXT I
   : FOR I=1TO 7
   : IF STR(E$(),70+I*8,8)=" "THEN 2880
   : IF F1(I+1)>F1(I)THEN CONVERT F1(I)TO STR(E$(),X+1+8*I,4),(####)
   : CONVERT F1(I+1)-F1(I)TO STR(E$(),X+5+8*I,4),(####)
2880 NEXT I
   : PACK(####)E$FROMF1()
   : E2$()=ALL(00)
   : PRINT HEX(0202000F);
   : LOAD T#2,"IDS2PC20"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PC19"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"