|
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: 6604 (0x19cc)
Types: s3xseg
Names: »SXRF40B«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF40B«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF40B«
0000 H C 12 XRF40B
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 $ZX40B
0030 F* SEARCHES DETAIL FILE FOR FIELD,RECORD,FIELD/RECORD ENTERED
0040 F* DISPLAYS RECORD FOUND WITH INSERT OR CHANGE SCREEN REQUESTED
0050 F* SETS UP FOR INSERTS AT BEGINNING OR END OF FILE DETAIL
0060 F* NO FILE UPDATES ARE PERFORMED
0070 F*
0080 FSCREENINIP F 66 66 SPECIAL SUBR92
0090 F KARA
0100 FSCREENO O F 153 153 SPECIAL SUBR92
0110 F KARA
0120 FDIRDESGNIC F 96 96R DISK40
0130 E ARA 5 5 6 CCP ARRAY
0140 I*
0150 I* 01 DEFINES A FILE SEARCH REQUEST
0160 I*
0170 ISCREENINAA 01 15 C'
0180 I 22 29 SFILEN
0190 I 30 30 SFUNCT
0200 I 31 36 SFLDNM 10
0210 I 37 42 SRECNM 11
0220 I 43 480SRRNO
0230 I 49 540FRRNO 12
0240 I 55 60 SCHNM1
0250 I 61 66 SCHNM2
0260 I*
0270 I* 02 RETURN TO XRF SCREEN
0280 I* 03 DEFINES INVALID KEY USED
0290 I*
0300 I BB 02 15 C5
0310 I OR 03
0320 I*
0330 I* DEFINES FIELD DESCRIPTION RECORD
0340 I*
0350 IDIRDESGNAA 50 1 CC
I/COPY R1,AUX054
I 1 1 RECCD
0420 I OFSTA 16
0430 I OFSET 17
0490 I 91 960NRRNO 18
0500 I*
0510 I* DEFINES RECORD DESCRIPTION RECORD
0530 I* DELETED RECORDS
0540 I*
0550 I BB 51 1 CB
0570 I OR 53 1 CD
0560 I/COPY R1,AUX052
I 1 1 RECCD
0590 I RECNM 54
0610 I RECOUT 55
0620 I 91 960NRRNO 18
0520 I*
0520 I* DEFINES COMMENT RECORD
0520 I*
0560 I CC 52 1 C*
0560 I/COPY R1,AUX056
0490 I 91 960NRRNO 18
0630 C SETOF 9192
0640 C 01 EXSR ERRCHK
0650 C 01 90 GOTO END
0660 C 20
0670 COR 21 EXSR SEARCH
0680 C 23 EXSR SEOF
0690 C END TAG
0700 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******************************************************
0710 C*
0720 C* ERRCHK EDITS ALL INPUT DATA FROM SEARCH SCREEN
0730 C* A COMMON INDICATOR 90 IS SET FOR ANY RERROR
0740 C*
0750 CSR ERRCHK BEGSR
0760 CSR SFUNCT COMP 'I' 20
0770 CSR SFUNCT COMP 'C' 21
0780 CSR SFUNCT COMP 'B' 22
0790 CSR SFUNCT COMP 'E' 23
0800 CSRN20N21N22
0810 CANN23 SETON 8790 BAD SEARCH
0820 CSR 20 10 11 SETON 878890BAD FLD/RECNNM
0840 CSR 20 12 NO ACTV RECDS
0850 COR 21 12 B SEARCH
0860 COR 23 12 SETON 8990 ONLY
0870 CSR ENDSR
0880 C*
0890 C* SEOF CHASES RELATIVE RECORD CHAIN TO SET INSERT AT
0900 C* THE END OF ACTIVE DETAIL
0910 C*
0920 CSR SEOF BEGSR
0930 CSR Z-ADDFRRNO TRRNO
0940 CSR LOOP2 TAG
0950 CSR SETOF 505152
0960 CSR SETOF 53
0970 CSR TRRNO CHAINDIRDESGN
0980 CSRN18 Z-ADDNRRNO TRRNO
0990 CSR 18 SETON 28
1000 CSRN28 GOTO LOOP2
1010 CSR ENDSR
1020 C*
1030 C* SEARCH READS FILE FOR A MATCH ON FIELD,RECORD,OR FIELD/RECORD
1040 C* IF NOT FOUND ERROR INDICATOR 27 IS SET
1050 C*
1060 CSR SEARCH BEGSR
1070 CSR Z-ADDSRRNO TRRNO 60
CSR 10 11N12 Z-ADDFRRNO TRRNO
CSR 10 11 12 SETON 90
CSR 90 GOTO NOOFF
1080 CSR LOOP1 TAG
1090 CSR SETOF 505152
1100 CSR SETOF 53
1110 CSR TRRNO CHAINDIRDESGN
1120 CSR 51 MOVE RECNM SCHNM1
1130 CSR 51 MOVE RECOUT SCHNM2
CSR 10 11 GOTO ENDSCH
1140 CSR 50N10
1150 COR 51 10N11 GOTO COMPNM
1160 CSR GOTO NEXT
1170 CSR COMPNM TAG
1180 CSR 50 SFLDNM COMP FLDNM 25
1190 CSR 50N25 GOTO NEXT
1200 CSRN11 SRECNM COMP SCHNM1 26
1210 CSRN11N26 SRECNM COMP SCHNM2 26
1220 CSR 50 11 SETON 26
1230 CSR 26 GOTO ENDSCH
1240 CSR NEXT TAG
1250 CSR 18 Z-ADDFRRNO NRRNO
1260 CSR NRRNO COMP SRRNO 27
1270 CSR 27 GOTO ENDSCH
1280 CSR Z-ADDNRRNO TRRNO
1290 CSR GOTO LOOP1
1300 CSR ENDSCH TAG
CSR 10 11N12 SETON 26
1310 CSR 27 SETON 90
1320 CSRN26
1330 CORN50
1340 COR 26 16 GOTO NOOFF
1350 CSR MLLZO1 OFSET CONVERT NUMER
1360 CSR MOVELOFSET SOFSET 4 FOR ALPHA
1370 CSR MOVE ' ' SOFSET DISPLAY
1380 CSR 17 MOVE '-' SOFSET
1390 CSR NOOFF TAG
1400 CSR ENDSR
1410 O*
1420 O* PUT OVERRIDE TO HIGHLIGHT PROMPTS OF ERROR FIELDS
1430 O* AND DISPLAY ERROR MESSAGES
1440 O*
1450 OSCREENO D 01 90
1460 O OR 03
1470 O 4 'HGB'
1480 O 8 '100'
1490 O 15 'B'
1500 O 24 'HDR4 1 '
1510 O 87 24 'HDR4 2 '
1520 O 33 'HDR5 1 '
1530 O 88 33 'HDR5 2 '
1540 O 27N10 33 'HDR5 2 '
1550 O 42 'HDR6 1 '
1560 O 88 42 'HDR6 2 '
1570 O 27N11 42 'HDR6 2 '
1580 O 51 'ERROR15 '
1590 O 89 51 'ERROR12 '
1600 O 60 'ERROR25 '
1610 O 87 60 'ERROR22 '
1620 O 69 'ERROR35 M'
1630 O 27 69 'ERROR32 M'
1640 O 03 69 'ERROR32 M'
1650 O 27 91 '*** RECORD/FIELD NAME '
1660 O 27 100 'NOT FOUND'
1650 O 10 11 12 91 '*** NO ACTIVE RECORDS '
1660 O 10 11 12 100 'IN FILE '
1670 O 03 88 '*** INVALID KEY HIT'
1680 O*
1690 O* PUT CHANGE SCREEN WITH RECORD FOUND IN SEARCH
1700 O*
1710 OSCREENO D 21 26
1720 O 4 'GB'
1730 O 8 '153'
1740 O 20 '$ZX40C'
1750 O SFILEN 28
1760 O SCHNM1 34
1770 O SCHNM2 40
1780 O RECCD 41
1790 O 50 FLDNM 47
1800 O 51 RECNM 47
1810 O 51 RECOUT 53
1820 O FLDDS 83
1830 O 51 RECDS 83
1840 O 50 FLDLN 86
1850 O 50 DECPS 87
1860 O 50 PB 88
1870 O 50 EDIT 89
1880 O 50 SOFSET 93
1890 O 50 16 93 ' '
1900 O 50 NOELE 97
1910 O 50 PATH 98
1920 O 50 IDXLEN 100
1930 O 50 QTITLE 115
1940 O TRRNO 122
1950 O FRRNO 128
1960 O*
1970 O* PUT INSERT SCREEN FOR INSERTION AT SEARCH LOCATION
1980 O* OR END OF ACTIVE FILE
1990 O*
2000 OSCREENO D 20 26
2010 O OR 23
2020 O 4 'GB'
2030 O 8 '122'
2040 O 20 '$ZX40D'
2050 O SFILEN 28
2060 O SCHNM1 34
2070 O SCHNM2 40
2080 O RECCD 41
2090 O 50 FLDNM 47
2100 O 51N54 RECNM 47
2110 O 51 54N55RECOUT 47
2120 O FLDDS 77
2130 O 51 RECDS 77
2140 O TRRNO 83
2150 O FRRNO 89
2160 O*
2170 O*
2180 O* PUT INSERT SCREEN FOR INSERTION AT BEGINNING
2190 O*
2200 O D 22
2210 O 4 'GB'
2220 O 8 '122'
2230 O 20 '$ZX40D'
2240 O SFILEN 28
2250 O 71 'INSERT BEGINNING OF FILE'
2260 O 77 ' B REC'
2270 O 83 '000000'
2280 O FRRNO 89
2290 O*
2300 O*
2310 O* PUT XRF SCREEN FOR NEW FILE KEY
2320 O*
2330 O D 02
2340 O 4 'CB'
2350 O 8 '20'
2360 O 20 '$ZXRF1'
2370 O D 02
2380 O 4 'CB'
2390 O 8 '51'
2400 O 20 '$ZXRF2'
2410 O 39 '*** ENTER NEXT FILE'
2420 O 47 'REQUEST'
**
D 66