Listing of file='LPPUTDEF' on disk='vmedia/701-2721C.wvd.zip'
# Sector 493, program filename = 'LPPUTDEF'
0005 COM K8$(254)1, S$40, Z1$20
0140 DIM S9$1,S4$3,E$1,X1$20,Y1$20
: PRINT AT(15,12);"Do you want to save the DATAMERGE definition? (Y/N) ";
: S$="Y"
0170 GOSUB '123(S$,1,15,64,0404,"AL",HEX(82F0))
: PRINT AT(23,0,);
: IF S9$=HEX(F0)THEN GOTO 1070
: IF S$="N"THEN 980
: IF S$="Y"THEN 260
: PRINT AT(23,0);HEX(070E);"Enter 'Y' for YES or 'N' for NO";HEX(0F);
: GOTO 170
0260 S$=L0$(6)
0270 PRINT AT(15,03,77);"Please Enter the Definition Name ";AT(21,50);"Press E
XEC/RUN to Continue";AT(22,50);" CANCEL/EDIT to Terminate"
0280 GOSUB '123(S$,20,15,37,2424,"L",HEX(82F0))
: PRINT AT(23,0,80);
: Z1$=S$
: IF S9$=HEX(F0)THEN 1070
: IF Z1$<>" "THEN 335
: PRINT AT(23,0,80);HEX(070E);"Definition Name Required";HEX(0F);
: GOTO 280
0335 IF Z1$<>L0$(6)THEN 340
: PRINT AT(18,0,);
: GOTO 360
0340 S$=" "
: PRINT AT(16,10);"Enter the Description";
: GOSUB '123(S$,40,16,37,2424,"L",HEX(82F0))
: PRINT AT(18,0,);
: IF S9$=HEX(F0)THEN 1070
0360 IF E$="T"THEN 450
: E$="F"
: IF Z1$<>L0$(6)THEN 390
: PRINT AT(23,0);HEX(0E);"Updating Definition";
: GOTO 950
0390 GOSUB '140(1,"150")
: LOAD T<R9>R9$()7050,7999BEG 410
0410 GOSUB '150("B 2 3 5 2352")
: IF M<>0THEN GOSUB '74(1,"open DD")
: GOSUB '140(3,"151153156")
: LOAD T<R9>R9$()7050,7999BEG 450
0450 GOSUB '151("EQ","B",Z1$," "," "," "," ")
: IF M=52THEN 510
: IF M<>0THEN GOSUB '74(1,"find B")
: PRINT AT(23,0);HEX(0E07);"Definition ";HEX(22);Z1$;HEX(22);" Already Exis
ts";HEX(0F);
: E$="T"
: S$=" "
: PRINT AT(16,0,80);
: GOTO 270
0510 L0$(6)=Z1$
: PRINT AT(23,0,);HEX(0E);"Storing Definition";HEX(0F);
: X1$=L0$(1)&"-"&R5$&"-"
: Y1$=X1$&"99999"
: GOSUB '151("LT","5",Y1$," "," "," "," ")
: IF M=64OR STR(M2$,1,LEN(X1$))<>X1$THEN GOTO 640
: IF M<>0THEN GOSUB '74(1,"find LT ")
: CONVERT STR(M2$,LEN(X1$)+1)TO Y
: Y=Y+1
: CONVERT YTO Y1$,(#####)
: L0$(2)=X1$&Y1$
: GOTO 660
0640 L0$(2)=L0$(1)&"-"&R5$&"-00000"
0660 K8$()=ALL(HEX(20))
: GOSUB '153(" ",K8$(),"5",L0$(2)," "," "," "," ")
: IF M<>0THEN GOSUB '74(1,"stor 5")
: K8$()=" "
: STR(K8$(),1,5)=R5$
: STR(K8$(),6,6)=B4$
: STR(K8$(),12,16)=B9$
: STR(K8$(),28,20)=L0$(2)
: STR(K8$(),49,3)=L9$(1)
: STR(K8$(),52,3)=L9$(2)
: STR(K8$(),55,1)="N"
: FOR I=1TO G3STEP 1
0790 IF STR(G3$(I),22,3)<>"Ent"THEN GOTO 820
: STR(K8$(),55,1)="Y"
: I=G3
0820 NEXT I
: STR(K8$(),56,40)=S$
: STR(K8$(),96,5)=B3$
: IF L0(5)=1THEN STR(K8$(),101,8)=L0$(1)
: GOSUB '153(" ",K8$(),"B",Z1$," "," "," "," ")
: IF M<>0THEN GOSUB '74(1,"stor B")
: IF L0(5)=1THEN GOTO 940
: K8$()=" "
: GOSUB '153(" ",K8$(),"5",L0$(2)," ","2",L0$(1)," ")
: IF M<>0THEN GOSUB '74(1,"stor 52")
0940 GOSUB '156("ALL")
: IF M<>0THEN GOSUB '74(1,"clos DD")
0950 COM CLEAR K8$()
: LOAD T"PKNEWST "
0980 COM CLEAR K8$()
: S=VAL(STR(K9$,7,1))
: L=VAL(STR(K9$,8,1))
: X$=STR(K9$,S,8)
: MAT COPY K9$<S+8,L-8>TO K9$<S,L-8>
: STR(K9$,S+L-8,8)="@MENU"
: PRINT AT(1,0,);
: LOAD TX$
1070 COM CLEAR K8$()
: LOAD T"LPRETURN"
6000 DEFFN'123(S$,S1,S2,S3,S7,S5$,S6$)
6001 S5=S3
: $TRAN(S6$,HEX(FE0D))R
: S4=1
: S8$=BIN(INT(S7/1000))&BIN(MOD(INT(S7/100),10))
: PRINT AT(S2,S3);HEX(0202020F0204);STR(S8$,1,2);HEX(0E);STR(S$,1,S1);AT(S2
,S3);
6006 PRINT HEX(05);
: KEYIN S9$,,6027
: PRINT HEX(06);
: IF S9$=HEX(84)THEN 6006
: $TRAN(S9$,HEX(FE0D))R
: IF POS(HEX(82FEA1E5)=S9$)>0THEN 6030
: IF S9$=HEX(08)THEN 6073
: IF S4>S1THEN 6006
: IF POS(S5$="S")>0AND S9$=" "THEN S9$=HEX(80)
: PRINT AT(S2,S5);S9$;
: STR(S$,S4,1)=S9$
: IF POS(S5$="A")>0AND S4>=S1THEN 6021
: S5=S5+1
: S4=S4+1
: GOTO 6006
6021 S8$=BIN(MOD(INT(S7/10),10))&BIN(MOD(INT(S7),10))
: IF POS(S5$="L")>0THEN S7=LEN(S$)
: ELSE S7=S1
: PRINT AT(S2,S3);HEX(0202020F0204);STR(S8$,1,2);HEX(0E);STR(S$,1,S7);HEX(0
202000F020402000F);
: IF POS(S5$="L")>0AND LEN(S$)<S1THEN PRINT STR(S$,LEN(S$)+1,S1-LEN(S$));
: IF POS(S5$="A")>0AND S4>=S1AND POS(S6$=S9$)=0THEN S9$=HEX(FF)
: RETURN
6027 PRINT HEX(06);
: $TRAN(S9$,HEX(0A4A0A5A094909590C5C0C4C0D5D0D4DE548))R
: IF S9$=HEX(0D)THEN 6058
6030 PRINT HEX(06);
: IF POS(S6$=S9$)>0THEN 6021
: IF S9$=HEX(E5)THEN 6080
: ON VAL(S9$)-3GOTO 6035,6006,6006,6041,6044,6047,6049,6054,6056,6058,6060
: GOTO 6006
6035 IF LEN(S$)=S1THEN S4=S1
: ELSE IF S$<>" "THEN S4=LEN(S$)+1
: ELSE S4=1
: S5=S3+LEN(S$)
: IF S$=" "THEN S5=S3
: IF S5>S3+S1-1THEN S5=S3+S1-1
6039 PRINT AT(S2,S5);
: GOTO 6006
6041 S5=S3
: S4=1
: GOTO 6039
6044 STR(S$,S4)=" "
6045 PRINT AT(S2,S3);STR(S$,1,S1);AT(S2,S5);
: GOTO 6006
6047 STR(S$,S4)=STR(S$,S4+1)
: GOTO 6045
6049 FOR S6=S1TO S4+1STEP -1
: IF S6>1THEN STR(S$,S6,1)=STR(S$,S6-1,1)
: NEXT S6
: STR(S$,S4,1)=" "
: GOTO 6045
6054 S6=5
: GOTO 6061
6056 S6=1
: GOTO 6061
6058 S6=-1
: GOTO 6061
6060 S6=-5
6061 S5=S5+S6
: S4=S4+S6
: IF S4>0THEN 6066
: S4=1
: S5=S3
6066 S6=LEN(S$)
: IF S$=" "THEN S6=0
: IF S4<=S6THEN 6071
: S5=S3+S6
: S4=S6+1
6071 PRINT AT(S2,S5);
: GOTO 6006
6073 S4=S4-1
: S5=S5-1
: IF S4>0THEN 6078
: S4=1
: S5=S3
6078 IF POS(S5$="S")=0THEN STR(S$,S4,1)=" "
: ELSE STR(S$,S4,1)=HEX(80)
: GOTO 6045
6080 S$=" "
: GOTO 6001
9500 DEFFN'74(M4,L0$(4))
: GOSUB '140(1,"160")
: LOAD T<R9>R9$()7050,7999BEG 9530
9530 GOSUB '160(M4,"LPPUTDEF",L0$(4))
: COM CLEAR A0$()
: LOAD TR3$(2)
9996 DEFFN'1"CLEARP7000,7999";HEX(0D);
9997 DEFFN'2"DIM A$,A,B,C,D";HEX(0D);
9998 DEFFN'16"RENUMBER 100-1999 TO 100";HEX(0D);
9999 DEFFN'3
: A$="LPPUTDEF"
: SCRATCH TA$
: SAVE T()A$
: PRINT HEX(03060E22);A$;HEX(22);" saved ";HEX(0F);
: LIMITS TA$,A,B,C,D
: PRINT C;" Sectors used, ";B-A-C+1;" available"
: LIST DT
: PRINT AT(2,0,3*80);AT(5,0);"On device:";AT(6,0,1);AT(6,4,)
: RETURN