image of READY prompt

Wang2200.org

Listing of file='IDS2PF06' on disk='vmedia/701-2717B.wvd.zip'

# Sector 742, program filename = 'IDS2PF06'
1000 REM "IDS2PF06" - Release 2.1 - DATA FILE - FIELD ATTRIBUTE EDIT
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
   : R3$(1)="IDS2PF03"
   : STR(F6$(),12,2)="NN"
   : IF F8=1THEN 1140
   : GOTO 1050
1040 PRINT HEX(07);
1050 GOSUB '63("Touch desired FN"," key in UPPER box, FN'31 = CANCEL, EXEC = a
     ccept field as shown"," ")
   : GOSUB '34(250)
   : IF Q=32OR Q=82THEN 1120
   : IF Q=31THEN 2000
   : ON QGOTO 1140,1220,1290,1330,1400,1480,1550,1590,1630,1710
   : PRINT HEX(07);
   : GOTO 1050
1120 GOSUB '43(9)
   : IF Q>0THEN LOAD DC T#2,"IDS2PF08"1000,
   : GOSUB '35("Field length cannot be zero")
   : GOTO 1330
1135 GOSUB '45(6," ")
1140 GOSUB '34(6)
   : GOSUB '71(E$)
   : IF Q=0THEN 1200
   : IF E$=F1$AND F8=2THEN 1200
   : GOSUB '38(32," ")
   : GOTO 1135
1195 GOSUB '38(33," ")
   : GOTO 1135
1200 IF F8<>1THEN 1050
   : MAT SEARCH"BLANKFLDCPU ID #STATION#TERMINALPARTIT'NOPERATORUSERCLASNEWTRA
     N#NEXTSEQ#",=STR(E$,,8)TO F9$STEP 8
   : IF F9$>HEX(0000)OR VER(E$,"@TSTFLD#")=8OR E$="@SYSBUF0"THEN 1195
   : IF E$>"FILE # 0"AND E$<"FILE # 8"THEN 1195
   : GOTO 1330
1220 GOSUB '43(7)
   : IF E$<>" "THEN 1225
   : IF F2$<>" "THEN GOSUB '45(7,F2$)
   : ELSE GOSUB '45(7," ")
1225 GOSUB '34(7)
   : IF E$<>" "THEN 1230
   : GOSUB '45(8," ")
   : J2=1
   : J3=1991
   : C0=7
   : GOTO 1050
1230 C1$=E$
   : GOSUB '43(6)
   : IF E$<>C1$THEN 1235
   : GOSUB '45(7," ")
   : GOSUB '45(8," ")
   : PRINT HEX(07)
   : GOTO 1225
1235 GOSUB '71(C1$)
   : IF Q>0THEN 1240
   : GOSUB '38(34,C1$)
   : GOSUB '45(7," ")
   : GOTO 1220
1240 J2=INT(VAL(STR(E$(),493+6*Q),2)/16)
   : F4,F6=VAL(STR(E$(),495+6*Q))
   : J3=J2+F4-1
   : C0=INT(MOD(VAL(STR(E$(),494+6*Q)),16)/2)
   : E6$=BIN(Q)
   : MAT SEARCHE$()<502,1490>,=E6$TO F8$()STEP 6
   : X=1
   : J5=J2
1260 IF F8$(X)=HEX(0000)THEN 1270
   : Y=498+VAL(F8$(X),2)
   : J5=MAX(J2,INT(VAL(STR(E$(),Y),2)/16)+VAL(STR(E$(),Y+2)))
   : X=X+1
   : GOTO 1260
1270 CONVERT J5-J2+1TO E$,(###)
   : GOSUB '45(8,E$)
   : CONVERT J5TO E$,(####)
   : GOSUB '45(10,E$)
   : CONVERT C0TO E$,(#)
   : GOSUB '45(11,E$)
   : GOTO 1290
1290 GOSUB '43(7)
   : IF E$=" "THEN 1040
   : GOSUB '71(E$)
   : F6=VAL(STR(E$(),495+6*Q))
   : GOSUB '43(9)
   : J6=Q
   : GOSUB '34(8)
   : IF Q>=1AND Q<=F6-J6+1THEN 1315
   : E8$=" "
   : CONVERT F6-J6+1TO E8$,(###)
   : GOSUB '38(35,E8$)
   : GOSUB '55(8,1)
   : GOTO 1290
1315 GOSUB '55(10,Q+J2-1)
   : GOTO 1050
1325 GOSUB '38(36," ")
   : GOSUB '55(9,255)
1330 GOSUB '34(9)
   : I=Q
   : IF Q>255THEN 1325
   : GOSUB '43(7)
   : IF E$=" "THEN 1380
   : GOSUB '71(E$)
   : F4=VAL(STR(E$(),495+6*Q))
   : GOSUB '43(8)
   : J6=Q
   : GOSUB '43(9)
   : IF Q>0AND Q<=F4-J6+1THEN 1380
   : E8$=" "
   : CONVERT F4-J6+1TO E8$,(###)
   : GOSUB '38(37,E8$)
   : GOSUB '55(9,1)
   : GOTO 1330
1380 GOSUB '43(14)
   : IF I>QTHEN 1385
   : GOSUB '38(39," ")
   : GOSUB '55(9,Q+1)
   : GOTO 1330
1385 IF D2>1AND D2<>4THEN 1050
   : GOSUB '43(10)
   : IF Q+I-1<=80THEN 1050
   : GOSUB '35("Position plus length must be less than 80")
   : GOTO 1330
1400 GOSUB '34(10)
   : J6=Q
   : GOSUB '43(7)
   : IF E$<>" "THEN 1405
   : J2=1
   : J3=1991
   : IF D2=1OR D2=4THEN J3=80
   : GOTO 1410
1405 GOSUB 1820
   : GOSUB '43(9)
   : IF J6<J2OR J6>J3-Q+1THEN 1420
   : GOSUB '55(8,J6-J2+1)
   : GOTO 1050
1410 GOSUB '43(9)
   : IF J6>=J2AND J6<=J3-Q+1THEN 1050
1420 F0$="Position of field in record must be between #### and ####"
   : CONVERT J2TO STR(F0$,POS(F0$="#"),4),(####)
   : CONVERT J3-Q+1TO STR(F0$,POS(F0$="#"),4),(####)
   : GOSUB '35(F0$)
   : GOSUB '55(10,J2)
   : GOTO 1400
1480 GOSUB '34(11)
   : J6=Q
   : GOSUB '43(7)
   : IF E$=" "THEN C0=7
   : ELSE GOSUB 1820
   : Q=J6
   : IF Q<=C0THEN 1050
   : E8$=" "
   : CONVERT C0TO E8$,(#)
   : GOSUB '38(38,E8$)
   : GOSUB '55(11,C0)
   : GOTO 1480
1550 GOSUB '43(12)
   : IF E$="Y"THEN GOSUB '45(12,"N")
   : ELSE GOSUB '45(12,"Y")
   : GOTO 1050
1590 GOSUB '43(13)
   : IF E$="Y"THEN GOSUB '45(13,"N")
   : ELSE GOSUB '45(13,"Y")
   : GOTO 1050
1630 GOSUB '43(11)
   : IF Q<>2AND Q<>3THEN 1040
1650 GOSUB '34(14)
   : D1=Q
   : GOSUB '43(9)
   : IF D1<QTHEN 1690
   : O=39
1685 GOSUB '38(O," ")
   : GOSUB '55(14,0)
   : GOTO 1650
1690 IF D1<8THEN 1050
   : O=40
   : GOTO 1685
1710 GOSUB '43(15)
   : C1$=E$
   : GOSUB '43(7)
   : IF E$=" "THEN 1715
   : GOSUB '71(E$)
   : J9=Q*6+493
   : C1$=STR(E$(),J9+5,1)
   : HEXUNPACKSTR(C1$,,1)TO C1$
   : C1$=STR(C1$,1,1)
   : GOSUB '34(15)
   : IF E$<C1$THEN 1750
   : GOTO 1720
1715 GOSUB '34(15)
1720 IF E$>="0"AND E$<="9"THEN 1050
   : IF E$>="A"AND E$<="F"THEN 1050
   : GOSUB '38(41," ")
   : GOSUB '45(15,C1$)
   : GOTO 1710
1750 GOSUB '38(42,STR(C1$,,1))
   : GOSUB '45(15,C1$)
   : GOTO 1710
1770 DEFFN'71(E$)
   : MAT SEARCHF$(),=STR(E$,1,8)TO F9$STEP 8
   : Q=INT((VAL(F9$,2)+7)/8)
   : RETURN
1820 GOSUB '71(E$)
   : IF Q=0THEN 1830
   : J2=INT(VAL(STR(E$(),493+6*Q),2)/16)
   : F4,F6=VAL(STR(E$(),495+6*Q))
   : J3=J2+F4-1
   : C0=INT(MOD(VAL(STR(E$(),494+6*Q)),16)/2)
   : RETURN
1830 GOSUB '38(34,E$)
   : GOSUB '45(7," ")
   : GOSUB '45(8," ")
   : J2=1
   : J3=1991
   : C0=7
   : RETURN
2000 LOAD DC T#2,"IDS2PF03"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
   : E$="IDS2PF06"
   : IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
   : STOP "ERROR"