|
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: 9906 (0x26b2)
Types: s3xseg
Names: »SXRF40C«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF40C«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF40C«
0000 H R XRF40C
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 $ZX40C
0030 F* UPDATES RECORD DISPLAYED AND DISPLAYS NEXT ACTIVE RECORD
0040 F* WHEN SCREEN ENTERED
0050 F* FLAGS RECORD FOR DELETION IF REQUESTED DELETES ENTIRE RECORD
0060 F* GROUP IF B HEADER RECORD IS DELETED
0070 F* AUTOMATICALLY PROMPTS INSERT IF ALL DETAIL RECORDS DELETED
0080 F* SETS UP FOR INSERT OF RECORD AFTER ONE DISPLAYED
0090 F*
0100 FSCREENINIP F 129 129 SPECIAL SUBR92
0110 F KARA
0120 FSCREENO O F 153 153 SPECIAL SUBR92
0130 F KARA
0140 FIDXDESGNUC F 96 96R 8AI 2 DISK40 A
0150 FDIRDESGNUC F 96 96R DISK40
0160 E ARA 5 5 6 CCP ARRAY
0170 E OFAR 4 1 OFFSET WORK
0180 E TABVP 8 8 1 A VALID TYPES
0200 I*
0210 I* 01 DEFINES CHANGE RECORD REQUEST
0220 I* 02 DEFINES INSERT MODE REQUEST
0230 I* 03 RETURN TO SEARCH SCREEN
0240 I*
0250 ISCREENINAA 01 15 C'
0260 I OR 02 15 C3
0270 I OR 03 15 C4
0280 I 22 29 SFILEN
0290 I 30 35 SCHNM1
0300 I 36 41 SCHNM2
0310 I 42 42 SRECCD
0320 I 43 48 SFLDNM 09
0330 I 49 54 SRECOU 10
0340 I 55 84 SFLDDS 11
0350 I 85 870SFLDLN 1212
0360 I 88 88 SDECPS 13
0370 I 89 89 SPB
03705I 90 90 SEDIT
0390 I 91 94 SOFSET 15
0430 I 91 94 OFAR
0370 I 95 980SNOELE
0380 I 99 99 SPATH
0390 I 100 1010SIDXL
0400 I 102 116 SQTITL
0450 I 117 117 SDEL 19
0460 I 118 1230TRRNO
0470 I 124 1290FRRNO
0480 I*
0490 I* 04 RETURN TO XRF SCREEN
0500 I* 05 DEFINES INVALID KEY USED
0510 I*
0520 I BB 04 15 C5
0530 I OR 05
0540 I*
0550 I* DEFINES FIELD DESCRIPTION RECORD
0560 I*
0570 IDIRDESGNAA 50 1 CC
I/COPY R1,AUX054
I 1 1 RECCD
0420 I OFSTA 16
0430 I OFSET 17
0710 I 91 960NRRNO 18
0720 I*
0730 I* DEFINES RECORD DESCRIPTION RECORD
0740 I* COMMENT RECORD
0750 I* DELETED RECORDS
0760 I*
0770 I BB 51 1 CB
0790 I OR 53 1 CD
0560 I/COPY R1,AUX052
I 1 1 RECCD
0590 I RECNM 54
0610 I RECOUT 55
0840 I 91 960NRRNO 18
0520 I* DEFINES COMMENT RECORD
0520 I*
0560 I CC 52 1 C*
0560 I/COPY R1,AUX056
0490 I 91 960NRRNO 18
0850 IIDXDESGNAA 01
0860 I 16 45 FILDS
0870 C SETOF 9192
0880 C 01 EXSR ERRCHK
0890 C 01N90 EXSR UPDATE
C 03
0900 COR 02 EXSR MDECHG
0910 C 37N54
0920 COR 03 SFILEN CHAINIDXDESGN
0930 C EXCPT
0940 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******************************************************
0950 C*
0960 C* UPDATE CHANGES RECORD ENTERED AND PAGES TO NEXT ACTIVE
0970 C* DELETES RECORD AND PAGES TO NEXT ACTIVE
0980 C* DELETES ALL RECORDS OF A RECORD GROUP IF B RECORD IS
0990 C* DELETED AND PAGES TO NEXT ACTIVE
1000 C* IF NO ACTIVE RECORDS AFTER DELETE WILL PROMPT INSERT
1010 C*
1020 CSR UPDATE BEGSR
1030 CSR LOOP1 TAG
1040 CSR 42 SETOF 41
1050 CSRN42 SETON 4142 FIRST TIME
1060 CSR Z-ADDNRRNO CRRNO 60
1070 CSR 41 Z-ADDTRRNO CRRNO
1080 CSR SETOF 505152
1090 CSR SETOF 53
1100 CSR CRRNO CHAINDIRDESGN
1110 CSRN41 CRRNO COMP FRRNO 44
1120 CSR 44 SETON 43
1130 CSRN51 GOTO BYP
1140 CSR 41 MOVE SFLDNM SCHNM1
1150 CSR 41 MOVE SRECOU SCHNM2
1160 CSR 41 GOTO BYP
1170 CSR SETOF 40
1180 CSR MOVE RECNM SCHNM1
1190 CSR MOVE RECOUT SCHNM2
1200 CSR BYP TAG
1210 CSRN53 SETON 54
1220 CSR 41 34
1230 COR 40 SETOF 54
1240 CSR 40N53
1250 COR 41N53 SETON 35 UPDATE RECORD
1260 CSR 35 EXCPT
1270 CSR SETOF 35
1280 CSR 18 Z-ADDFRRNO NRRNO
1290 CSR 41 34
1300 COR 40
1310 COR 53 NRRNO COMP TRRNO 37FILE WRAP
1320 CSR 37N54 GOTO ENDUPD
1330 CSR 53
1340 COR 40
1350 COR 41 GOTO LOOP1
1360 CSR SETON 39
1370 CSRN50
1380 COR 16 GOTO ENDUPD
1390 CSR MLLZO1 OFSET CONVERT NUMER
1400 CSR MOVELOFSET SOFSET FOR ALPHA
1410 CSR MOVE ' ' SOFSET DISPLAY
1420 CSR 17 MOVE '-' SOFSET
1430 CSR ENDUPD TAG
1440 CSR ENDSR
1450 C*
1460 C* MDECHG SETS UP FOR PROMPT OF INSERT AFTER DISPLAYED RECORD
C* OR SEARCH SCREEN
1470 C*
1480 CSR MDECHG BEGSR
1490 CSR TRRNO CHAINDIRDESGN
1500 CSR 51 MOVE RECNM SCHNM1
1510 CSR 51 MOVE RECOUT SCHNM2
CSR 03 18 Z-ADDFRRNO NRRNO
1520 CSR ENDSR
1530 C*
1540 C* ERRCHK EDITS ALL IMNPUT FROM CHANGE SCREEN
1550 C* A COMMON INDICATOR 90 IS SET FOR ANY ERROR
1560 C*
1570 CSR ERRCHK BEGSR
1580 CSR SRECCD COMP 'B' 20
1590 CSR SRECCD COMP 'C' 21
1600 CSR SRECCD COMP '*' 22
1610 CSRN19 SDEL COMP 'D' 333334
1620 CSR 20 34 SETON 40
1630 CSR 20
1640 COR 22 GOTO STERR
1650 CSR SPB LOKUPTABVP 23
1670 CSRN23 GOTO CKOFF
1680 CSR SPB COMP 'A' 25
1690 CSRN25 SPB COMP 'L' 25
CSRN25 SPB COMP 'B' 30
CSRN25N30 SPB COMP 'C' 30
CSR 30N12 SFLDLN COMP 4 3131
CSR 30N12 31SFLDLN COMP 2 1212
1700 CSR 25N12 SFLDLN COMP 256 12
1710 CSRN25N12N30SFLDLN COMP 15 12
1720 CSRN25N13 SDECPS COMP '0' 13
1730 CSRN25N13 SDECPS COMP '9' 13
1740 CSR CKOFF TAG
1750 CSRN15 21 EXSR CVTOFF
1760 CSR STERR TAG
1770 CSRN19 33 BAD DELT CODE
1780 COR 20 09 10 BAD FLD/REC NM
1800 COR 21N23 BAD TYPE
1820 COR 21 12 SETON 90 BAD FLD LGTH
1830 CSR 21N25 13 BAD DECIMAL
1840 COR 21 29 BAD OFFSET
1850 COR 21 25N13 SETON 90 BAD DECIMAL
1870 CSR ENDSR
1880 C*
1890 C* CVTOFF CONVERTS OFFSET ENTERED IN ALPHA FILED TO NUMERIC
1900 C* FIELD DESCRIBED AS ALPHA ON SCREEN
1910 C* BECAUSE BOTH BLANK AND ZERO ARE VALID
1920 C*
1930 CSR CVTOFF BEGSR
1940 CSR Z-ADD4 X 10
1950 CSR CKBK TAG
1960 CSR OFAR,X COMP ' ' 26
1970 CSR 26 X SUB 1 X
1980 CSR 26 GOTO CKBK
1990 CSR OFAR,X COMP '-' 27
2000 CSR 27 X SUB 1 X 29
2010 CSR 29 GOTO ENDCVT
2020 CSR Z-ADD4 Y 10
2030 CSR AGN1 TAG
2040 CSR MOVE OFAR,X OFAR,Y
2050 CSR X SUB 1 X 26
2060 CSR Y SUB 1 Y 28
2070 CSRN26 GOTO AGN1
2080 CSR AGN2 TAG
2090 CSRN28 MOVE '0' OFAR,Y
2100 CSRN28 Y SUB 1 Y 28
2110 CSRN28 GOTO AGN2
2120 CSR MOVEAOFAR SOFSET
2130 CSR SOFSET COMP '0000' 29
2140 CSRN29 SOFSET COMP '0999' 29
2150 CSRN29 MOVE SOFSET SOFSTN 30
2160 CSR 27 MLLZO-1 SOFSTN
2170 CSR ENDCVT TAG
2180 CSR ENDSR
2190 O*
2200 O* PUT OVERRIDE TO HIGHLIGHT PROMPTS OF ERROR FIELDS OR
2210 O* DISPLAY ERROR MESSAGES
2220 O*
2230 OSCREENO E 01 90
2240 O OR 05
O 8 'HGB0126'
2270 O 15 'B'
2280 O 22 'HDR6 1'
2300 O 20 09 10 22 'HDR6 2'
2310 O 31 'HDR7 1'
2320 O 20 09 10 31 'HDR7 2'
2350 O 40 'HDR12 1'
2360 O 21 12 40 'HDR12 2'
2370 O 49 'HDR13 1'
2380 O 21N25 13 49 'HDR13 2'
2390 O 21 25N13 49 'HDR13 2'
2400 O 58 'HDR14 1'
2410 O 21N23 58 'HDR14 2'
2440 O 67 'HDR16 1'
2450 O 21 29 67 'HDR16 2'
2460 O 76 'HDR21 1'
2470 O 33 76 'HDR21 2'
2480 O 85 'ERROR15'
2490 O 90 87 'ERROR12 M'
2500 O 05 87 'ERROR12 M'
2510 O 90 110 '*** RQD FIELDS MISSING/'
2520 O 90 117 'INVALID'
2530 O 05 106 '*** INVALID KEY HIT'
2540 O 124 'ERROR25'
2550 O*
2560 O* PUT CHANGE SCREEN WITH NEXT ACTIVE RECORD
2570 O*
2580 O E 01N90 39
O 8 'GB0153'
2610 O 20 '$ZX40C'
2620 O SFILEN 28
2630 O SCHNM1 34
2640 O SCHNM2 40
2650 O RECCD 41
2660 O 51 RECNM 47
2670 O 50 FLDNM 47
2680 O 51 RECOUT 53
2700 O FLDDS 83
O 51 RECDS 83
2710 O 50 FLDLN 86
2720 O 50 DECPS 87
2730 O 50 PB 88
27305O 50 EDIT 89
2750 O 50 SOFSET 93
2760 O 50 16 93 ' '
2770 O 50 NOELE 97
2780 O 50 PATH 98
2790 O 50 IDXLEN 100
2800 O 50 QTITLE 115
2810 O CRRNO 122
2820 O FRRNO 128
2830 O 43 147 '*** FILE WRAPPED TO'
2840 O 43 153 'START'
2850 O*
2860 O* PUT INSERT SCREEN IF ALL ACTIVE RECORDS
2870 O* HAVE BEEN DELETED
2880 O*
2890 O E 01N90 37
2900 O AND N54
O 8 'GB0122'
2930 O 20 '$ZX40D'
2940 O SFILEN 28
2950 O 70 'ENTER FIRST RECORD TYPE'
2960 O 72 '-B'
O 89 '000000000000'
2990 O 113 '*** ALL RECDS DELETED-IN'
3000 O 122 'SERT ONLY'
3010 O*
3020 O* PUT INSERT SCREEN TO ALLOW INSERTION
3030 O* AFTER DISPLAYED RECORD
3040 O*
3050 O E 02
O 8 'GB0122'
3080 O 20 '$ZX40D'
3090 O SFILEN 28
3100 O SCHNM1 34
3110 O SCHNM2 40
3120 O RECCD 41
3130 O FLDNM 47
3140 O FLDDS 77
3145 O 51 RECDS 77
3150 O TRRNO 83
3160 O FRRNO 89
3170 O*
3180 O* PUT SEARCH SCREEN
3190 O*
3200 O E 03
O 8 'GB0082'
3230 O 20 '$ZX40B'
3240 O SFILEN 28
3250 O FILDS 58
3260 O NRRNO 64
3270 O FRRNO 70
3280 O SCHNM1 76
3290 O SCHNM2 82
3300 O*
3310 O* PUT XRF SCREEN FOR NEW FILE KEY
3320 O*
3330 O E 04
O 8 'CB0020'
3360 O 20 '$ZXRF1'
3370 O E 04
O 8 'CB0051'
3400 O 20 '$ZXRF2'
3410 O 39 '*** ENTER NEXT FILE'
3420 O 47 'REQUEST'
3430 O*
3440 O* UPDATE OR DELETE DISPLAYED RECORD
3450 O*
3460 ODIRDESGNE 35 41
3470 O SRECCD 1
3480 O SFILEN 9
3490 O N22 SFLDNM 15
3500 O SFLDDS 45
3510 O 20 SRECOU 51
3520 O 21 SFLDLN 48
3530 O 21 SDECPS 49
3540 O 21 SPB 50
3550 O 21 SOFSTN 53
3560 O 21 15 53 ' '
3570 O 21 SNOELE 57
3580 O 21 SEDIT 58
3590 O 21 SPATH 59
3600 O 21 SIDXL 61
3610 O 21 SQTITL 76
3620 O 34 1 'D'
3630 O*
3640 O*
3650 O*
3660 O* DELETE RECORDS OF A RECORD GROUP
3670 O*
3680 O E 35 40N41
3690 O 1 'D'
3700 O*
3710 O* DUMMY ADD TO ALLOW ACCESS TO ADDED RECORDS
3720 O*
3730 OIDXDESGNEADD 01N01
3740 O*
3750 O* UPDATES FIRST RECORD POINTER IF ALL
3760 O* RECORDS ARE DELETED
3770 O*
3780 OIDXDESGNE 37N54
3790 O 15 '000000'
**
D 129
**
ABCLNOPQ