Listing of file='609MERG2' on disk='vmedia/731-0067F-disk1.wvd.zip'
# Sector 2355, program filename = '609MERG2'
0010 REM %^ '609MERG2' - 2ND EXECUTION MODULE FOR DOCUMENT MERGE
0145 PRINT HEX(0202000E);
0280 C2$()=" "
: IF C9=-2AND J2=2THEN GOSUB 1570
: ELSE GOTO 300
: GOTO 2610
0300 D2=0
: D5,D3=0
: J5=VAL(STR(C4$(),15),2)-1
: GOSUB 1750
: J8=POS(C0$()=83)+1
: C2$()=STR(C0$(),,J8-1)
: GOSUB 2080
0420 KEYIN C$,420,440
: GOTO 460
0440 IF C$=HEX(F0)THEN 2620
: ELSE GOTO 420
0460 GOSUB 780
: IF D3=1AND D1=0THEN 2625
: IF D3=0THEN GOSUB 1260
: IF D4=1THEN 610
: STR(T1$,,8)=$PSTAT(#PART)
: IF A4$=" "AND R3$()=" "THEN A4$="609MENU"
: IF A4$=" "AND R3$()<>" "THEN A4$=$PSTAT(#PART)
: IF D3=1THEN 660
0550 IF D2=0THEN 420
: GOSUB 1150
: GOTO 660
0610 IF D3=0THEN GOSUB 1150
: GOSUB 1570
: GOTO 2610
0660 IF T5(2)=2THEN 730
: GOSUB '50(HEX(8F),1)
: IF C2$()=" "THEN 280
: V1$()=C2$()
: GOSUB 2020
: GOTO 280
0730 GOSUB 1570
: IF C9=-2AND T5(2)=2AND J2=2THEN GOTO 2610
: A5$()="609MERG1609Open JCATSMALREC-GEN"
: LOAD T<4>A5$()0,9999BEG 550
0780 D6=POS(STR(C0$(),J8)=HEX(7F))-1
: IF D6=-1THEN D6=999
: D7=POS(STR(C0$(),J8)=HEX(FF))-1
: IF D7=-1THEN D7=999
: D8=POS(STR(C0$(),J8)=HEX(8F))-1
: IF D8=-1THEN D8=999
: D9=MIN(D6,D7,D8)
: IF D9=999THEN 1090
: IF D9=D8THEN 970
: D1=1
: IF D9>0THEN GOSUB '50(STR(C0$(),J8,D9),0)
: J8=J8+D9+1
: IF D9=D6THEN D5=0
: ELSE D5=1
: IF D2=1THEN 780
: RETURN
0970 IF D9>-1THEN GOSUB '50(STR(C0$(),J8,D9+1),1)
: IF D8=-1OR D8=999THEN RETURN
: IF C2$()=" "THEN 1010
: V1$()=C2$()
: GOSUB 2020
1010 GOSUB 1750
: J8=POS(V1$()=83)+1
: C2$()=STR(C0$(),,J8-1)
: GOSUB 2080
: GOTO 780
1090 D9=246-J8+1
: IF D9>0THEN GOSUB '50(STR(C0$(),J8,D9),0)
: GOSUB 1750
: IF D3=1THEN RETURN
: GOTO 780
1150 D9=246-J8+1
1160 IF D9>0THEN GOSUB '50(STR(C0$(),J8,D9),0)
: GOSUB 1750
: IF D3=1THEN RETURN
: J8=1
: D9=246
: GOTO 1160
1240 D2=0
1260 D6=POS(STR(C1$(),J9)=HEX(7F))-1
: IF D6=-1THEN D6=999
: D7=POS(STR(C1$(),J9)=HEX(FF))-1
: IF D7=-1THEN D7=999
: D8=POS(STR(C1$(),J9)=HEX(8F))-1
: IF D8=-1THEN D8=999
: D9=MIN(D6,D7,D8)
: IF D9=999THEN 1500
: IF D9=D8THEN 1450
: IF D9>0AND D5=0THEN GOSUB '50(STR(C1$(),J9,D9),0)
: IF D9=D7THEN D2=1
: J9=J9+D9+1
: IF POS(STR(C1$(),J9)<>" ")=0AND J1=J6THEN D4=1
: RETURN
1450 IF D9>0AND D5=0THEN GOSUB '50(STR(C1$(),J9,D9),0)
: GOSUB 1830
: J9=POS(C1$()=83)+1
: GOTO 1260
1500 D9=246-J9+1
: IF D9>0AND D5=0THEN GOSUB '50(STR(C1$(),J9,D9),0)
: J9=J9+D9
: GOSUB 1830
: IF D4=1THEN RETURN
: GOTO 1260
1570 IF C2$()=" "THEN 1610
: V1$()=C2$()
: GOSUB 2020
1610 V1$()=C3$()
: V4$="P"
: GOSUB '221(A3,1,1,1,1)
: A0(3)=J4
: $PACK(F=HEX(A019A0066006A002A001))C$()FROMA6$(),A7$(),A0(),A8$(),A9$()
: V1$()=C$()
: V4$="A"
: GOSUB '221(A3,1,2,1,1)
: GOSUB '212(A3)
: A3=-1
: RETURN
1750 J5=J5+1
: GOSUB '220(A1,1,J5,1,1)
: IF POS(HEX(002825)=R1$)=0THEN 2510
: C0$()=V1$()
: J8=1
: IF R1$=HEX(25)THEN D3=1
: RETURN
1830 J6=J6+1
: GOSUB '220(A2,1,J6,1,1)
: IF POS(HEX(002825)=R1$)=0THEN 2520
: C1$()=V1$()
: J9=1
: IF R1$=HEX(25)THEN D4=1
: RETURN
1910 DEFFN'50(C5$(),I1)
: IF POS(C5$()<>20)=0THEN RETURN
: C2=LEN(C2$())
: IF C2$()=" "THEN C2=0
: STR(C2$(),C2+1)=C5$()
: IF C2+LEN(C5$())<246AND STR(C2$(),LEN(C2$()),1)<>HEX(8F)THEN RETURN
: V1$()=C2$()
: GOSUB 2020
: IF I1=0THEN IF LEN(C2$())<246OR STR(C2$(),246,1)=HEX(8F)THEN GOSUB 2080
: C2$()=" "
: IF C2>0THEN C2$()=STR(C5$(),246-C2+1)
: RETURN
2020 J7=J7+1
: V0$()=V1$()
: $TRAN(V0$(),HEX(3F013F023F033F043F053F063F073F083F093F0A3F0B3F0C3F0D3F0E3
F0F))R
: PRINT AT(19,0,);STR(V0$(),,246);
: GOSUB '225(A3,1,1,1)
: IF R1$<>HEX(00)THEN 2530
: RETURN
2080 J4=J4+1
: C3$(J4)=BIN(J7+1,2)
: J2=J2+1
: PRINT AT(14,41);J2;
: RETURN
2140 DEFFN'31
: $CLOSE
: COM CLEAR U1$()
: A5$()="609CloseJCAT"
: LOAD T<2>A5$()
2500 % TEXT ISOLATION
2510 B2$="Reading Primary"
: GOTO 2540
2520 B2$="Reading Secondary"
: GOTO 2540
2530 B2$="Adding to New"
: GOTO 2540
2540 PRINT AT(23,0,);B5$(2);"Error ";B2$;" document";
: PRINT " = ";
: ON VAL(R1$)GOTO 2590,,,2600
: IF R1$>HEX(29)THEN CONVERT VAL(R1$)TO STR(B2$,,2),(##)
: ELSE HEXUNPACKR1$TO STR(B2$,,2)
: GOTO 2640
2590 B2$="Volume Full"
: GOTO 2640
2600 B2$="No Free Slots"
: GOTO 2640
2610 B2$="Request Completed"
: GOTO 2630
2620 B2$="Request Cancelled"
: GOTO 2630
2625 B2$="No MERGE codes were found in the primary document"
: GOTO 2630
2630 PRINT AT(23,0,);
2640 PRINT B2$;TAB(60);"Press CANCEL";B5$(1);HEX(07);
2650 KEYIN C$
: IF C$<>HEX(F0)THEN 2650
: IF A3<>-1THEN GOSUB '214(A3)
: A3=-1
: GOSUB '31