|
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: 9144 (0x23b8)
Types: s3xseg
Names: »SXRF40D«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF40D«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF40D«
0000 H R XRF40D
F*
F******************************************************
F* 5798-NKG COPYRIGHT IBM CORP. 1977. REFER TO *
F* INSTRUCTIONS ON COPYRIGHT NOTICE FORM NO. 120-2083*
F******************************************************
F*
0010 F*
0020 F* ACCEPTS AND EDITS INPUT FROM SCREEN $Z40D
0030 F* INSERTS DETAIL RECORD AFTER RECORD DISPLAYED AS PREVIOUS
0040 F* MAINTAINS RECORD CHAIN INTEGRITY
0050 F* ALLOWS RETURN TO CHANGE MODE FOR RECORD DISPLAYED AS PREVIOUS
0060 F*
0070 FSCREENINIP F 128 128 SPECIAL SUBR92
0080 F KARA
0090 FSCREENO O F 153 153 SPECIAL SUBR92
0100 F KARA
0110 FIDXDESGNUC F 96 96R 8AI 2 DISK40 A
0120 FDIRDESGNUC F 96 96R DISK40
0130 E ARA 5 5 6 CCP ARRAY
0140 E OFAR 4 1 OFFSET WORK
0150 E TABVP 8 8 1 A VALID TYPES
0170 I*
0180 I* 01 DEFINES INSERT REQUEST
0190 I* 02 DEFINES CHANGE MODE REQUEST
0200 I* 03 RETURN TO SEARCH SCREEN
0210 I*
0220 ISCREENINAA 01 15 C'
0230 I OR 02 15 C3
0240 I OR 03 15 C4
0250 I 22 29 SFILEN
0260 I 30 35 SCHNM1
0270 I 36 41 SCHNM2
0280 I 42 42 SRECCD
0290 I 43 48 SFLDNM 09
0300 I 49 54 SRECOU 10
0310 I 55 84 SFLDDS 11
0320 I 85 870SFLDLN 1212
0330 I 88 88 SDECPS 13
0340 I 89 89 SPB
0345 I 90 90 SEDIT
0350 I 91 94 OFAR
0360 I 91 94 SOFSET 15
0370 I 95 980SNOELE
0380 I 99 99 SPATH
0390 I 100 1010SIDXLN
0400 I 102 116 SQTITL
0410 I 117 1220PRRNO 08
0420 I 123 1280FRRNO 18
0440 I*
0450 I* 04 RETURN TO XRF SCREEN
0460 I* 05 DEFINES INVALID KEY USED
0470 I*
0480 I BB 04 15 C5
0490 I OR 05
0500 I*
0510 I* DEFINES FIELD DESCRIPTION RECORD
0520 I*
0530 IDIRDESGNAA 50 1 CC
I/COPY R1,AUX054
04195I 1 1 RECCD
0420 I OFSTA 16
0430 I OFSET 17
0670 I 91 960NRRNO 19
0680 I*
0690 I* DEFINES RECORD DESCRIPTION RECORD
0700 I* COMMENT RECORD
0710 I* DELETED RECORDS
0720 I*
0730 I BB 51 1 CB
0750 I OR 53 1 CD
0560 I/COPY R1,AUX052
0570 I 1 1 RECCD
0590 I RECNM 54
0610 I RECOUT 55
0670 I 91 960NRRNO 19
0810 I*
0520 I* DEFINES COMMENT RECORD
0520 I*
0560 I CC 52 1 C*
0560 I/COPY R1,AUX056
0670 I 91 960NRRNO 19
0820 I* DEFINES NEXT AVAILABLE RECORD POINTER
0830 I*
0840 I CC 1 CH
0850 I 91 960NRRNO
0860 I DD 1 C
0870 IIDXDESGNAA
0880 I 16 45 FILDS
0890 C SETOF 9192
0900 C 01 EXSR ERRCHK
0910 C 01N90 EXSR INSERT
C 03
0920 COR 02 EXSR MDECHG
0930 C 03 SFILEN CHAINIDXDESGN
0940 C EXCPT
0950 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******************************************************
0960 C*
0970 C* MDECHG SETS UP FOR PROMPT OF CHANGE THE PREVIOUS RECORD
C* OR SEARCH SCREEN
0980 C*
0990 CSR MDECHG BEGSR
1000 CSR 08 18 GOTO ENDMDE
1010 CSR 08 Z-ADDFRRNO PRRNO
1020 CSR SETOF 505152
1030 CSR SETOF 53
1040 CSR PRRNO CHAINDIRDESGN
CSR 03N19 Z-ADDNRRNO PRRNO
1050 CSRN50
COR 03
1060 COR 16 GOTO ENDMDE
1070 CSR MLLZO1 OFSET CONVERT NUMER
1080 CSR MOVELOFSET SOFSET FOR ALPHA
1090 CSR MOVE ' ' SOFSET DISPLAY
1100 CSR 17 MOVE '-' SOFSET
1110 CSR ENDMDE TAG
CSR 08 18 SETON 24
1120 CSR ENDSR
1130 C*
1140 C* ERRCHK EDITS ALL INPUT FROM INSERT SCREEN
1150 C* A COMMON INDICATOR 90 IS SET FOR ANY ERROR
1160 C*
1170 CSR ERRCHK BEGSR
1180 CSR SRECCD COMP 'B' 20
1190 CSR SRECCD COMP 'C' 21
1200 CSR SRECCD COMP '*' 22
1210 CSR 08 18N20 GOTO STERR
1220 CSR 20
1230 COR 22
1240 CORN20N21N22 GOTO STERR
1250 CSR SPB LOKUPTABVP 23
1270 CSRN23 GOTO CKOFF
1280 CSR SPB COMP 'A' 25
1290 CSRN25 SPB COMP 'L' 25
CSRN25 SPB COMP 'B' 33
CSRN25N33 SPB COMP 'C' 33
CSR 33N12 SFLDLN COMP 4 3434
CSR 33N12 34SFLDLN COMP 2 1212
1300 CSR 25N12 SFLDLN COMP 256 12
1310 CSRN25N12N33SFLDLN COMP 15 12
1320 CSRN25N13 SDECPS COMP '0' 13
1330 CSRN25N13 SDECPS COMP '9' 13
1340 CSR CKOFF TAG
1350 CSRN15 21 EXSR CVTOFF
1360 CSR STERR TAG
1370 CSR 08 18N20 SETON 8990 BAD MDE CHG
1380 CSR 20 09 10 BAD FLD/REC NM
1400 COR 21 25N13 BAD DECIMALS
1410 COR 21N23 BAD PB CODE
1430 COR 21 12 SETON 90 BAD FIELD LENG
1440 CSR 21N25 13 BAD DECIMALS
1450 COR 21 29 SETON 90 BAD OFFSET
1470 CSRN20N21N22 SETON 9088 BAD REC CODE
1480 CSR ENDSR
1490 C*
1500 C* INSERT ADDS RECORD TO DETAIL FILE AND MAINTAINS
1510 C* RELATIVE RECORD CHAIN
1520 C*
1530 CSR INSERT BEGSR
1540 CSR 20 MOVE SFLDNM SCHNM1
1550 CSR 20 MOVE SRECOU SCHNM2
1560 CSR 1 CHAINDIRDESGN
1570 CSR NRRNO ADD 1 IRRNO 60
1580 CSR SETON 30
1590 CSR EXCPT
1600 CSRN08 PRRNO CHAINDIRDESGN
1610 CSRN08 Z-ADDNRRNO INRRNO 60
1620 CSRN08 EXCPT
1630 CSR SETOF 30
1640 CSR 08 Z-ADDFRRNO INRRNO
1650 CSR 08 SFILEN CHAINIDXDESGN
1660 CSR 08 Z-ADDIRRNO FRRNO
1670 CSR IRRNO CHAINDIRDESGN
1680 CSR SETON 32
1690 CSR ENDSR
1700 C*
1710 C* CVTOFF CONVERTS OFFSET ENTERED IN ALPHA FIELD TO NUMERIC
1720 C* FIELD DESCRIBED AS ALPHA ON SCREEN
1730 C* BECAUSE BOTH BLANK AND ZERO ARE VALID
1740 C*
1750 CSR CVTOFF BEGSR
1760 CSR Z-ADD4 X 10
1770 CSR CKBK TAG
1780 CSR OFAR,X COMP ' ' 26
1790 CSR 26 X SUB 1 X
1800 CSR 26 GOTO CKBK
1810 CSR OFAR,X COMP '-' 27
1820 CSR 27 X SUB 1 X 29
1830 CSR 29 GOTO ENDCVT
1840 CSR Z-ADD4 Y 10
1850 CSR AGN1 TAG
1860 CSR MOVE OFAR,X OFAR,Y
1870 CSR X SUB 1 X 26
1880 CSR Y SUB 1 Y 28
1890 CSRN26 GOTO AGN1
1900 CSR AGN2 TAG
1910 CSRN28 MOVE '0' OFAR,Y
1920 CSRN28 Y SUB 1 Y 28
1930 CSRN28 GOTO AGN2
1940 CSR MOVEAOFAR SOFSET
1950 CSR SOFSET COMP '0000' 29
1960 CSRN29 SOFSET COMP '0999' 29
1970 CSRN29 MOVE SOFSET SOFSTN 30
1980 CSR 27 MLLZO-1 SOFSTN
1990 CSR ENDCVT TAG
2000 CSR ENDSR
2010 O*
2020 O* PUT OVERRIDE TO HIGHLIGHT PROMPTS OF ERROR FIELDS OR
2030 O* DISPLAY ERROR MESSAGES
2040 O*
2050 OSCREENO E 01 90
2060 O OR 05
2070 O OR 24
2080 O 4 'HGB'
2090 O 8 '127'
2100 O 15 'B'
2110 O 22 'HDR7 1'
2120 O 88 22 'HDR7 2'
2130 O 31 'HDR8 1'
2150 O 20 09 10 31 'HDR8 2'
2160 O 40 'HDR9 1'
2170 O 20 09 10 40 'HDR9 2'
2200 O 49 'HDR14 1'
2210 O 21 12 49 'HDR14 2'
2220 O 58 'HDR15 1'
2230 O 21N25 13 58 'HDR15 2'
2240 O 21 25N13 58 'HDR15 2'
2250 O 67 'HDR16 1'
2260 O 21N23 67 'HDR16 2'
2290 O 76 'HDR18 1'
2300 O 21 29 76 'HDR18 2'
2310 O 87 'ERROR12 M'
2360 O 89 110 '*** B RECORD ONLY VALID'
2320 O 24 110 '*** INVALID FUNCTION RE'
2330 O 24 08 18 118 'QUESTED'
2340 O 90 111 '*** REQD FIELDS MISSING/'
2350 O 90 118 'INVALID'
2370 O 89 118 'INSERT'
2380 O 127 'ERROR25 '
2390 O 05 106 '*** INVALID KEY HIT'
2400 O*
2410 O* PUT INSERT SCREEN FOR NEXT INSERT
2420 O*
2430 O E 01N90 32
2440 O 4 'GB'
2450 O 8 '122'
2460 O 20 '$ZX40D'
2470 O SFILEN 28
2480 O SCHNM1 34
2490 O SCHNM2 40
2500 O SRECCD 41
2510 O SFLDNM 47
2520 O 09N10 SRECOU 47
2530 O SFLDDS 77
2540 O IRRNO 83
2550 O FRRNO 89
2560 O*
2570 O* PUT CHANGE SCREEN TO ALLOW CHANGE OF
2580 O* PREVIOUS ENTRY
2590 O*
2600 O E 02N24
2620 O 4 'GB'
2630 O 8 '153'
2640 O 20 '$ZX40C'
2650 O SFILEN 28
2660 O SCHNM1 34
2670 O SCHNM1 40
2680 O RECCD 41
2690 O 51 RECNM 47
2700 O 50 FLDNM 47
2710 O RECOUT 53
2730 O FLDDS 83
2720 O 51 RECDS 83
2740 O 50 FLDLN 86
2750 O 50 DECPS 87
2760 O 50 PB 88
2770 O 50 EDIT 89
2780 O 50 SOFSET 93
2790 O 50 16 93 ' '
2800 O 50 NOELE 97
2810 O 50 PATH 98
2820 O 50 IDXLEN 100
2830 O 50 QTITLE 115
2840 O PRRNO 122
2850 O FRRNO 128
2860 O*
2870 O* PUT SEARCH SCREEN
2880 O*
2890 O E 03N24
2900 O 4 'GB'
2910 O 8 '82'
2920 O 20 '$ZX40B'
2930 O SFILEN 28
2940 O FILDS 58
2950 O PRRNO 64
2960 O FRRNO 70
2970 O SCHNM1 76
2980 O SCHNM2 82
2990 O*
3000 O* PUT XRF SCREEN FOR NEW FILE KEY
3010 O*
3020 O E 04
3030 O 4 'CB'
3040 O 8 '20'
3050 O 20 '$ZXRF1'
3060 O E 04
3070 O 4 'CB'
3080 O 8 '51'
3090 O 20 '$ZXRF2'
3100 O 39 '*** ENTER NEXT FILE'
3110 O 47 'REQUEST'
3120 O*
3130 O* UPDATE POINTER IN PREVIOUS RECORD
3140 O*
3150 ODIRDESGNE 30
3160 O IRRNO 96
3170 O*
3180 O* INSERT RECORD IN FILE
3190 O*
3200 O E 32
3210 O SRECCD 1
3220 O SFILEN 9
3230 O N22 SFLDNM 15
3240 O SFLDDS 45
3250 O 20 SRECOU 51
3260 O 21 SFLDLN 48
3270 O 21 SDECPS 49
3280 O 21 SPB 50
3290 O 21 SOFSTN 53
3300 O 21 15 53 ' '
3310 O 21 SNOELE 57
3320 O 21 SEDIT 58
3330 O 21 SPATH 59
3340 O 21 SIDXLN 61
3350 O 21 SQTITL 76
3360 O INRRNO 96
3370 O*
3380 O* DUMMY ADD TO ALLOW ACCESS TO ADDED RECORDS
3390 O*
3400 OIDXDESGNEADD 01N01
3410 O*
3420 O* UPDATE FIRST RECORD POINTER IF
3430 O* INSERT WAS FIRST FOR THE FILE
3440 O*
3450 OIDXDESGNE 32 08
3460 O IRRNO 15
**
D 128
**
ABCLNOPQ