|
|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5334 (0x14d6)
Types: s3xseg
Names: »SXRF40A«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF40A«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF40A«
0000 H C 12 XRF40A
F*
F******************************************************
F* 5798-NKG COPYRIGHT IBM CORP. 1977. REFER TO *
F* INSTRUCTIONS ON COPYRIGHT NOTICE FORM NO. 120-2083*
F******************************************************
F*
0020 F* ACCEPTS AND EDITS INPUT FROM SCREEN $ZX40A
0030 F* ADDS TO AND UPDATES RECORDS IN FILE INFORMATION FILE
0040 F*
0050 FSCREENINIP F 112 112 SPECIAL SUBR92
0060 F KARA
0070 FSCREENO O F 122 122 SPECIAL SUBR92
0080 F KARA
0090 FIDXDESGNUC F 96 96R 8AI 2 DISK40 A
0100 E ARA 5 5 6 CCP ARRAY
0110 I*
0120 I* 01 DEFINES FILE ADD REQUEST
0130 I* 02 DEFINES FILE UPDATE REQUEST
0140 I*
0150 ISCREENINAA 01 15 C' 22 CA
0160 I OR 02 15 C' 22 CU
0170 I 23 30 SFILEN
0180 I 31 60 SFILDS
0190 I 61 640SRECLN 0505
0200 I 65 71 SDEVIC
0210 I 72 74 SFILTP 06
0220 I 75 780SKEYST 0708
0230 I 79 800SKEYLN 0910
0240 I 81 83 SSEQ 11
0250 I 84 111 SPKGDS
0260 I 112 112 SDEL 12
0270 I*
0280 I* 03 RETURN TO XRF SCREEN
0290 I* 04 DEFINES INVALID KEY USED
0300 I*
0310 I BB 03 15 C5
0320 I OR 04
0330 I*
0340 I* DEFINES BEGINNING OF DETAIL FILE CHAIN
0350 I*
0360 IIDXDESGNAA 22 1 CA
0370 I 10 150FRRNO 20
0380 I BB 13
0390 C SETOF 9192
0400 C 01
0410 COR 02 EXSR ERRCHK
0420 C 02N90 21 SETON 03
0430 C 02N90 21 SETOF 02
0440 C SETON LR
C******************************************************
CLR MOVE '5798-NKG'COIBM 8
CLR MOVE 'COPYRIGH'COIBM
CLR MOVE 'T IBM CO'COIBM
CLR MOVE 'RP. 1977'COIBM
C******************************************************
0450 C*
0460 C* ERRCHK EDITS ALL DATA FROM INPUT SCREEN FOR ADD OR CHANGE
0470 C* A COMMON INDICATOR 90 IS SET FOR ANY ERROR
0480 C*
0490 CSR ERRCHK BEGSR
0500 CSR SFILEN CHAINIDXDESGN 14
0510 CSR 01N14
0520 COR 02 14
0530 COR 02N14 13 SETON 90
0540 C*
0550 CSRN06 SFILTP COMP 'CON' 1515
0560 CSRN06 15 SFILTP COMP 'IDX' 1515
0570 CSRN06 15 SFILTP COMP 'DIR' 1515
0580 CSRN09N10 SKEYLN COMP 29 16
0590 CSRN08N10 SKEYST ADD SKEYLN SKEYEN 40
05905CSRN08N10 SKEYEN SUB 1 SKEYEN
0600 CSRN08N10 SKEYEN COMP SRECLN 17
0610 CSRN11 SSEQ COMP 'SEQ' 1818
0620 CSRN11 18 SSEQ COMP 'UND' 1818
0630 CSR 02N12 SDEL COMP 'D' 191921
0640 CSR 05 BAD RECD LGTH
0650 COR 15 BAD FILE TYPE
0660 COR 07 BAD KEY STRT
0670 COR 09 BAD KEY LGTH
0680 COR 08N10 BAD KEY STRT
0690 COR 18 SETON 9089 BAD LOAD SEQ
0700 CSR 17 BAD KEY/RECD
0710 COR 10N08 BAD RECD LGTH
0720 COR 19 SETON 9089 BAD DLT CODE
0730 CSR ENDSR
0740 O*
0750 O* PUT SEARCH SCREEN IF UPDATE REQUEST AND
0760 O* ACTIVE DETAIL RECORDS IN FILE
0770 O*
0780 OSCREENO D 02N90N20
0790 O 4 'GB'
0800 O 8 '82'
0810 O 20 '$ZX40B'
0820 O SFILEN 28
0830 O SFILDS 58
0840 O FRRNO 64
0850 O FRRNO 70
0860 O 82 ' '
0870 O*
0880 O* PUT INSERT SCREEN IF ADD REQUESTED OR
0890 O* UPDATE REQUEST WITH NO ACTIVE DETAIL RECORDS
0900 O*
0910 O D 02N90 20
0920 O OR 01N90
0930 O 4 'GB'
0940 O 8 '122'
0950 O 20 '$ZX40D'
0960 O SFILEN 28
0970 O 70 'ENTER FIRST RECORD TYPE'
0980 O 72 '-B'
0990 O 83 '000000'
1000 O 89 '000000'
1010 O*
1020 O* PUT OVERRIDE TO HIGHLIGHT PROMPTS OF ERROR FIELDS
1030 O* AND TO DISPLAY ERROR MESSAGES
1040 O*
1050 OSCREENO D 01 90
1060 O OR 02 90
1070 O OR 04
1080 O 4 'HGB'
1090 O 8 '118'
1100 O 15 'B'
1110 O 24 'HDR4 1 '
1120 O 05 24 'HDR4 2 '
1130 O 17 24 'HDR4 2 '
1140 O 33 'HDR6 1 '
1150 O 15 33 'HDR6 2 '
1160 O 42 'HDR7 1 '
1170 O 07 42 'HDR7 2 '
1180 O 17 42 'HDR7 2 '
1190 O 08N10 42 'HDR7 2 '
1200 O 51 'HDR8 1 '
1210 O 09 51 'HDR8 2 '
1220 O 17 51 'HDR8 2 '
1230 O 10N08 51 'HDR8 2 '
1240 O 16 51 'HDR8 2 '
1250 O 60 'HDR9 1 '
1260 O 18 60 'HDR9 2 '
1270 O 69 'HDR11 1 '
1280 O 19 69 'HDR11 2 '
1290 O 78 'ERROR15 '
1300 O 89 78 'ERROR12 '
1310 O 87 'ERROR25 M'
1320 O 01N14 87 'ERROR22 M'
1330 O 01N14 110 '*** ADD FILE ALREADY ON'
1340 O 01N14 118 ' FILE '
1350 O 02 14 87 'ERROR22 M'
1360 O 02N14 13 87 'ERROR22 M'
1370 O 02 14 109 '*** CHANGE FILE NOT ON'
1380 O 02 14 118 ' FILE '
1390 O 02N14 13 110 '*** CHANGE FILE ALREADY'
1400 O 02N14 13 118 'DELETED'
1410 O 04 87 'ERROR22 M'
1420 O 04 106 '*** INVALID KEY HIT'
1430 O*
1440 O* PUT XRF SCREEN TO ALLOW NEW FILE KEY
1450 O*
1460 O D 03
1470 O 4 'CB'
1480 O 8 '20'
1490 O 20 '$ZXRF1'
1500 O D 03
1510 O 4 'CB'
1520 O 8 '51'
1530 O 20 '$ZXRF2'
1540 O 39 '*** ENTER NEXT FILE'
1550 O 47 'REQUEST'
1560 O*
1570 O* ADD RECORD TO FILE DESCRIPTION FILE
1580 O*
1590 OIDXDESGNDADD 01N90
1600 O SFILEN 9
1610 O 15 '000000'
1620 O SFILDS 45
1630 O SRECLN 49
1640 O SFILTP 52
1650 O SSEQ 55
1660 O SKEYST 59
1670 O SKEYLN 61
1680 O SDEVIC 68
1690 O SPKGDS 96
1700 O 1 'A'
1710 O*
1720 O* UPDATE AND DELETE RECORDS FROM FILE
1730 O*
1740 O D 02N90
1750 O OR 03 21
1760 O SFILDS 45
1770 O SRECLN 49
1780 O SFILTP 52
1790 O SSEQ 55
1800 O SKEYST 59
1810 O SKEYLN 61
1820 O SDEVIC 68
1830 O SPKGDS 96
1840 O 03 1 'D'
**
D 112