Listing of file='IDS2PS41' on disk='vmedia/701-2724B.wvd.zip'
# Sector 577, program filename = 'IDS2PS41'
1000 REM "IDS2PS41" - Release 2.1 - PASS/FAIL DOCUMENTATION FOR COPY
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: E$=" copy"
: IF F1$<>" "AND F1$<>"BLANKFLD"THEN 1040
: E$=E$&" all blanks"
: GOTO 1500
1040 IF F1$<>E9$(2)THEN 1050
: E$=E$&" the work buffer"
: GOTO 1500
1050 MAT SEARCHC9$,=STR(F1$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1060
: E$=E$&" record "&F1$
: GOTO 1500
1060 MAT SEARCHE3$(),=STR(F1$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)AND VER(F1$,"@TSTFLDH")<8AND F1$<>"@SYSBUF0"THEN 1081
: IF E6$="J"THEN E$=E$&" indirect"
: IF E6$="I"THEN E$=E$&" field "&F1$
: ELSE E$=E$&" the field named in "&F1$
: GOTO 1500
1081 IF F1$="CPU ID #"THEN E$=E$&" the CPU ID Number"&HEX(FF)
: IF F1$="STATION#"THEN E$=E$&" the station number"&HEX(FF)
: IF F1$="TERMINAL"THEN E$=E$&" the terminal number"&HEX(FF)
: IF F1$="PARTIT'N"THEN E$=E$&" the partition number"&HEX(FF)
: IF F1$="OPERATOR"THEN E$=E$&" the Operator ID"&HEX(FF)
1086 IF F1$="USERCLAS"THEN E$=E$&" the User Security Class"&HEX(FF)
: IF F1$="NEWTRAN#"THEN E$=E$&" a new Transaction number"&HEX(FF)
: IF F1$="NEXTSEQ#"THEN E$=E$&" the next Sequence number"&HEX(FF)
: IF STR(F1$,,4)="HEX("THEN E$=E$&" all "&F1$&"'s "&HEX(FF)
1090 IF F1$="ERRORMSG"THEN E$=" the last error message or prompt"&HEX(FF)
: IF F1$="@ERRMGS#"THEN E$=" the last system error message number"&HEX(FF)
: IF POS(E$=FF)=0THEN 1100
: STR(E$,POS(-E$=FF),1)=" "
: GOTO 1500
1100 IF E6$="J"THEN E$=" indirect copy using "&F1$&" & "&F2$
: ELSE E$=" copy "&F1$&" to "&F2$
: GOSUB '48(0,E$,0)
: AND (STR(E0$(),5,1),DF)
: GOSUB '49(0)
: GOSUB 2510
: E$="ERROR ! ******** Invalid copy specification"
: GOTO 2120
1500 E$=E$&" to"
: IF F2$<>" "AND F2$<>"BLANKFLD"THEN 1520
: E$=E$&" nowhere (?)"
: GOTO 2120
1520 IF F2$<>E9$(2)THEN 1530
: E$=E$&" the work buffer"
: GOTO 2120
1530 MAT SEARCHC9$,=STR(F2$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)THEN 1540
: E$=E$&" record "&F2$
: GOTO 2120
1540 MAT SEARCHE3$(),=STR(F2$,,8)TO F9$STEP 8
: IF F9$=HEX(0000)AND VER(F2$,"@TSTFLDH")<8AND F2$<>"@SYSBUF0"THEN 1100
: IF E6$="I"THEN E$=E$&" field "&F2$
: ELSE E$=E$&" the field named in "&F2$
2120 GOSUB '48(0,E$,0)
: AND (STR(E0$(),5,1),DF)
: GOSUB '49(0)
: GOSUB 2510
: LOAD T#2,"IDS2PS30"1000,
2510 IF C5$<>"S"OR STR(R3$(1),6,1)<>"S"THEN D6=D6+1
: ELSE F4=F4+1
: RETURN
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PS41"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"