|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/36 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/36 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 26368 (0x6700)
Notes: MEMBER_S, Member_Text
Names: »#SAWM «
└─⟦14ba21fd6⟧ Bits:30009812 REF.NO PWD34 PGM 5727-UT6 FEAT9074 UTILITIES US Z250-0041-2 REV/LEV 05.01 SEQ. 1/2 DISKET 2S 96TPI INTERNAL 88.03.04 31
└─⟦93ec53657⟧
└─⟦this⟧ ».#SAWM «
* J* SDA REQUIRES THE ORDERED, TAGGED C SPECS IN THIS MODEL * J* FOR SUCCESSFUL OPERATION... * J* DO NOT REMOVE, REORDER, OR RENUMBER (POSITIONS 2-5). * J* THIS MODEL ALSO CONTAINS SAMPLE SPECIFICATIONS AND COMMENTS * J* AND CAN BE USED AS INPUT TO SDA TO GENERATE A WSU PROGRAM. *@@@ J* SAMPLE SPECS PROVIDE ALL THE DEFAULTS (EXCEPT PROGRAM TYPE) *@@@ J* NECESSARY TO GENERATE AND COMPILE A FUNCTIONAL WSU PROGRAM. *@@@ J* (IF THIS DEFAULTING WERE NOT DESIRED...J, T, AND M SPECS *@@@ J* COULD HAVE BEEN OMITTED, AND S SPEC ENTRIES IN POSITIONS *@@@ J* 15-16, 24, 31-36, 45, AND 48-59 COULD HAVE BEEN LEFT BLANK.) *@@@ J* MASTER FILE 'MAILMS' MUST EXIST AT THE TIME THE GENERATED *@@@ J* AND COMPILED PROGRAM IS EXECUTED. *@@@ JMAIL #SAWM01 0128 *@@@ ** (SAMPLE HAS NO E SPECS) *@@ T* (SAMPLE REFERENCES ITSELF FOR THE T FILE DEFINITION) *@@@ TMAILTX #SDALIB #SAWM 89 88 *@@ M* (SAMPLE REFERENCES ITSELF FOR THE M FILE DEFINITION) *@@@ MMAILMS #SDALIB #SAWM BOX# 89 88 *@@@ ** (SAMPLE HAS NO M SPECS FOR EXTRA SECONDARY MASTER FILES) *@@@ ** (SAMPLE HAS NO M SPECS TO DEFINE LOCAL/SESSION LEVEL FIELDS) *@@ ** (THE FOLLOWING F & I SPECS DEFINE THE FILES FOR THE SAMPLE) *@@ FMAILTX UF 0093 *@@ IMAILTX 110001 C *@@ I 00060074 NOTE *@@ I 00770078 BOX# *@@ IMAILTX 870001NC *@@ I 00060074 NOTE *@@ FMAILMS UF 0080 02 I 0002 *@@ IMAILMS 010001 C *@@ I 00020003 BOX# *@@ I 00060022 NAME *@@ I 00250027 DEPT *@@ I 00300034 BLDG *@@ I 00370040 SITE *@@ I 00430046 EXTN *@@ I 00490050 WSTN *@@ IMAILMS 020001NC *@@ I 00060074 NOTE *@@@ ** (SAMPLE HAS NO IJ DISPLAY/PROCESSING) *@@@ ** (SAMPLE HAS NO IW DISPLAY/PROCESSING) * S@@BLANK@ YY Y * D 0302 P'@@BLANK@' *****C***************************************************************** *0000C NAE SETON AE89 IUATRV *0001C IS RV SETOF 87 0 IUATRV *@@@ ** (SAMPLE HAS NO M SPECS FOR EXTRA SECONDARY MASTER FILE ACCESS) *0002C N88N89 RR GET MS@@@@@@ 1 TRV *0003C NEW EXSR &XFRTN IUATRV *0004C ISNRR IMSG 'SELECT WSU OPTION ' 0 IUATRV *0005C NEWNRV DEBUG 0 IUATRV *@@@ S* (SAMPLE HAS THE FOLLOWING INPUT CAPABLE USER DISPLAYS: *@@@ S*------( ADD M AND T RECORDS )--------- *@@@ SAAFSPEC AA0124 Y 201101 3 11 *@@@ DNOTE 070188 Y Y F *@@@ DBOX# 090188 Y Y 88 Y Y F *@@@ DNAME 100188 Y Y F *@@@ DDEPT 110188 Y Y F *@@@ DBLDG 120188 Y Y F *@@@ DSITE 130188 Y Y F *@@@ DEXTN 140188 Y Y F *@@@ DWSTN 150188 Y Y F *@@@ S*------( VIEW AND UPDATE M RECORD AND PUT T RECORD )--------- *@@@ SUAMSPEC 0817 Y 1101 N 8 01 *@@@ DBOX# 020101 N Y F *@@@ DNAME 030101 Y Y F *@@@ DDEPT 040101 Y Y F *@@@ DBLDG 050101 Y Y F *@@@ DSITE 060101 Y Y F *@@@ DEXTN 070101 Y Y F *@@@ DWSTN 080101 Y Y F *@@@ S*------( REVIEW AND UPDATE/DELETE T RECORD )--------- *@@@ SUUFSPEC 0124 Y 11 N 4 11 *@@@ DNOTE 070111 Y Y F *@@@ DBOX# 090111 N Y F *@@@ S* (SAMPLE HAS THE FOLLOWING PRIMARY/PROMPT DISPLAY) *@@@ S*------( LOCATE M RECORD THEN WRITE T RECORDS )--------- *@@@ SPPFSPEC PP0124 YP 11 N 3 *@@@ D 0102 P'NOTES FOR WORK STATIONX *@@@ D USERS CAN BE LEFT IN TRANSACTION FILE MAILTX ' *@@@ D 0202 P'BY AN OWNER OF A BOX# X *@@@ DKEY DEFINED IN INDEXED MASTER FILE MAILMS. ' *@@@ D 0302 P'**** TO HANDLE MAILED X *@@@ DNOTES, USE WSU REVIEW FUNCTIONS. ' *@@@ D 0402 P'**** USE CMD13 (ENTER X *@@@ DMODE) OR CMD2 NOW (ENTER/INSERT MODE) OR ' *@@@ D 0502 P' USE CMD01 (SELECTX *@@@ D AA) ANYTIME TO BEGIN BOX ADD. ' *@@@ D 0602 P'NOTE TO USER : X *@@@ D ' *@@@ DNOTE 070889 Y 87 Y *@@@ D* (SAMPLE ALLOWS OPERATOR RECORD SELECTION BY KEY ENTRY) *@@@ D 0802 P'BOX# OF SENDER : X *@@@ D ' *@@@ ** (SAMPLE HAS THE FOLLOWING CHAIN FIELD DEFINITION, AS REQUIRED) *@@@ DBOX# 0002090889 Y Y *@@@ D 1602 P'**** USE CMD11 ANYTIMEX *@@@ D TO BEGIN BOX UPDATE. ' *@@@ D 1702 P'**** USE CMD21 TO GET X *@@@ DBOX# ENTERED OPEN THEN ' *@@@ D 1802 P' USE CMD22 TO PUT X *@@@ DEACH NEW NOTE ENTERED IN OPEN BOX. ' *@@@ D 2402 P'**** USE CMD01 (SELECTX *@@@ D FI OR FO) ANYTIME FOR COMMAND KEY HELP. ' *@@@ ** (SAMPLE HAS AN EXTRA C SPEC FOR SEGMENT PROCESSING) *@@@ C ISNRR IMSG 'SELECT A DIFFERENT X *@@@ CSESSION TO ACCESS MAIL IN ANOTHER BOX' *****C***************************************************************** *0006C MOVE '@@##' @@##SV004 IUATRV *0007C MOVE '######' CODESV006 IUATRV *0008C IPNEWNAC PUTS @@@@@@@@ IUATRV *0009C EXSR &IORTN IUATRV *@@@ S* (SAMPLE HAS THE FOLLOWING HELP-ONLY DISPLAYS) *@@@ SHELPFI FI0124 Y RR 0 *@@@ D 0104 P' HELP DISPLAY FI: X *@@@ DHOW TO ACCESS PROGRAM FILES ' *@@@ D 0206 P' NOTE:X *@@@ D FILE ACCESS IS AUTOMATIC FOR SOME DISPLAYS... ' *@@@ D 0306 P' X *@@@ D E.G. INSPECT MAY BE ASSUMED UPON KEY ENTRY. ' *@@@ D 0406 P' ADD CMD10 -X *@@@ D- Add a master record. ' *@@@ D 0506 P' INSPECT CMD11 -X *@@@ D- Read and extract fields from a master record. ' *@@@ D 0606 P' UPDATE CMD09 -X *@@@ D- Update a master record after inspection. ' *@@@ D 0706 P' LOCATE CMD21 -X *@@@ D- Read but extract no fields from a master record.' *@@@ D 0806 P' REPLACE CMD22 -X *@@@ D- Restore key values saved from LOCATE or INSPECT,' *@@@ D 0906 P' X *@@@ D replace a master record. ' *@@@ D 1006 P' WRITE CMD22 -X *@@@ D- Write a transaction record. ' *@@@ D 1106 P' X *@@@ D (add/update/insert depending on the WSU mode). ' *@@@ D 1206 P' REVIEW * -X *@@@ D- Read a transaction record... ' *@@@ D 1306 P' X *@@@ D * is one of the WSU-defined review functions ' *@@@ D 1406 P' X *@@@ D (ROLL UP/DOWN, CMD5/6/15, CMD1-WSU Menu RR#). ' *@@@ D 1506 P' BEGIN INSERT CMD04 -X *@@@ D- Begin insert mode for a transaction file... ' *@@@ D 1606 P' X *@@@ D New records go after the current review record. ' *@@@ D 1706 P' BEGIN DELETE CMD14 -X *@@@ D- Begin delete mode for a transaction file... ' *@@@ D 1806 P' X *@@@ D The current review record is deleted if the ' *@@@ D 1906 P' X *@@@ D delete function is ended. ' *@@@ D 2006 P' RESUME ENTER CMD03 -X *@@@ D- Resume normal enter mode file access processing.' *@@@ D 2106 P' END FUNCTION CMD08 -X *@@@ D- Set record type identifying indicators off, ' *@@@ D 2206 P' X *@@@ D end an alternate WSU mode function ' *@@@ D 2306 P' X *@@@ D or go back to the primary/prompt display. ' *@@@ SHELPFO FO0124 Y RR 0 *@@@ D 0104 P' HELP DISPLAY FO: X *@@@ DHOW TO CONTROL DISPLAY SELECTION ' *@@@ D 0206 P' NOTE:X *@@@ D FILE ACCESS USUALLY DRIVES DISPLAY SELECTION... ' *@@@ D 0306 P' X *@@@ D E.G. THE TYPE OF THE RECORD READ DETERMINES WHICH' *@@@ D 0406 P' X *@@@ D REVIEW-CAPABLE DISPLAY TO SHOW FOR INSPECT/REVIEW' *@@@ D 0506 P' X *@@@ D AND THE PRIMARY/PROMPT DISPLAY IS SHOWN AFTER ANY' *@@@ D 0606 P' X *@@@ D ADD/UPDATE/REPLACE/WRITE IN NORMAL ENTER MODE. ' *@@@ D 0706 P' END SESSION CMD07 -X *@@@ D- Set EW indicator for quick work session exit. ' *@@@ D 0806 P' END FUNCTION CMD08 -X *@@@ D- Set end function indicator for immediate display' *@@@ D 0906 P' X *@@@ D (unless in an alternate mode) of primary/prompt.' *@@@ D 1006 P' RESET CMD12 -X *@@@ D- Set reset indicators to activate format... ' *@@@ D 1106 P' X *@@@ D Complete any pending I/O, select active format ' *@@@ D 1206 P' X *@@@ D (bypass primary/prompt after ADD/UPDATE, E.G.) ' *@@@ D 1306 P' WSU MENU CMD01 -X *@@@ D- Enter a format ID to select a display. ' *@@@ D 1406 P' BYPASS CMD02 -X *@@@ D- Advance to next display, if any, in sequence. ' *@@@ D 1506 P' BYPASS SEQ. CMD13 -X *@@@ D- Advance (unless in an alternate mode) to next ' *@@@ D 1606 P' X *@@@ D enter mode selectable sequence. ' *@@@ D 1706 P' ACTIVE FORMAT CMD24 -X *@@@ D- Use reset indicators to select display. ' *@@@ D 1806 P' ACTIVE RECORD CMD23 -X *@@@ D- Use record type indicators to select display. ' *@@@ D 1906 P' RETURN CMD20 -X *@@@ D- Set RP indicator, return (unless function ended)' *@@@ D 2006 P' X *@@@ D to display sequence most recently responded to. ' *@@@ D 2106 P' RESUME CMD19 -X *@@@ D- Set RP indicator, resume (unless function ended)' *@@@ D 2206 P' X *@@@ D display sequence previously responded to ' *@@@ D 2306 P' X *@@@ D then suspended to work on another. ' *@@@ ** (SAMPLE HAS NO EW DISPLAY/PROCESSING) *@@@ ** (SAMPLE HAS NO EJ DISPLAY/PROCESSING) *@@@ ** (SAMPLE HAS NO C SPECS FOR ES PROCESSING) *@@@ ** (SAMPLE HAS NO C SPECS FOR EXTRA SUBROUTINES) *****C***************************************************************** *****C***************************************************************** *****C***************** I/O SUBROUTINE ******************************** *****C***************************************************************** *0010CSR &IORTN BEGSR IUATRV *0030C KL KK MSG 'RECORD READ ' 1 4 5 IUATRV *0060C KG KQ KR MSG 'NO MODEL PROMPT ' 764 5 IUATRV *0070C KG KQ KS MSG 'NO FORM PROMPT ' 764 5 IUATRV *0080C KG KL KX MSG 'NO ACTIVE MODEL ' 764 5 IUATRV *0090C KG KL KY MSG 'NO ACTIVE FORM ' 764 5 IUATRV *0100C KH KQ MSG 'FUNCTION ENDED ' 4 IUATRV *0130C KV KQ MSG 'MODEL READY ' 4 IUATRV *0140C KW KQ MSG 'FORM READY ' 4 IUATRV *0150C KV KU MSG 'MODEL RETURN ' 764 5 IUATRV *0160C KW KU MSG 'FORM RETURN ' 764 5 IUATRV *0170C KV KT MSG 'MODEL RESUME ' 764 5 IUATRV *0180C KW KT MSG 'FORM RESUME ' 764 5 IUATRV *0190C KL KX MSG 'ACTIVE MODEL ' 4 IUATRV *0200C KL KY MSG 'ACTIVE FORM ' 4 IUATRV *0209C KQ KG MSG 'REQUEST FUNCTION ' 4 IUATRV *0210C MOVE @@##SV ##SV 002 IUATRV *0211C ##SV COMP ' ' 87 IUATRV *0212C 87 MOVE 'S' MODESV001 IUATRV *0213C CODESV COMP ' 9999' 87 IUATRV *0214C 87 MOVE 'R' MODESV001 IUATRV *0216C MODESV COMP ' ' 87 IUATRV *0218C 87 MOVE 'S' MODESV001 IUATRV *0219C IS RV SETOF 87 0 IUATRV *0220C AC GOTO &ACTU IUATRV *0240C NIP IS RR SETON KX 0 IUATRV *0260C NIPNKX MODESV COMP 'R' KSKSKR IUATRV *0270C NIP GOTO &BEG IUATRV *0278C RV MSG 'REQUEST FUNCTION ' 8788 0 IUATRV *0279C @@##SV COMP @@##CR 87 2 IUATRV * C*@@@@@@@ AUTOGET *0320C AE MODESV COMP 'S' KK 1 5 IUATRV *0340C KK GOTO &ACTU 1 5 IUATRV *0365C NKRNKS SETON KH IUATRV *****C***************************************************************** *0380C &ACTU TAG IUATRV *0382C NKU MOVE @@##SV @@##RT004 2 IUATRV *0384C NKU MOVE MODESV MODERT001 2 IUATRV *****C***************************************************************** *0386C &BEG TAG IUATRV *0387C SETOF RCRS IUATRV *0390C IS RRNKX SETON 89 0 IUATRV *0400C KI RV GOTO &ERR 0 5 UAT + *0410C KJ RV GOTO &ERR 0 5 UAT *0420C KW RV GOTO &ERR 0 5 UAT *0430C KI GOTO &ERR 5 I TRV *0450C KJ GOTO &ERR 5 IU TRV *0460C KWNRR GOTO &ERR 0 5 RV *0470C NACNIPNIS GOTO &END IUATRV *0475C SETOF 88 IUATRV *0480C SETOF ACIPIS IUATRV *0490C KG SETON EW 6 5 IUATRV *0500C EW GOTO &END IUATRV *0502C ES GOTO &END IUATRV *0504C KQ VIEWCR COMP ' ' 88 2 76 5 IUATRV *0505C KU @@##RT COMP ' ' 88 2 76 5 IUATRV *0506C KT @@##RS COMP ' ' 88 2 76 5 IUATRV *0508C 88 MSG 'SELECTION ERROR ' 2 76 5 IUATRV *0510C KQ GOTO &ACTT 76 5 IUATRV *0520C KU GOTO &ACTT 76 5 IUATRV *0530C KT GOTO &END 76 5 IUATRV *0540C KV GOTO &GET 1 6 5 IUATRV *0550C KW GOTO &REP 6 5 UATRV *0570C KL GOTO &ACT 5 IUATRV *0580C KX GOTO &ACTX IUATRV *0590C KY GOTO &ACTY IUATRV *0600C KK GOTO &GET 1 5 IUATRV *0610C KH GOTO &ACTH 5 IUATRV *0620C KI GOTO &PUTI 1 5 UATR *0630C KJ GOTO &PUTJ 1 5 A *0640C KR GOTO &ACTT IUATRV *0650C KS GOTO &ACTT IUATRV *****C***************************************************************** *0660C &ERR TAG 5 IUATRV *0670C AC RR MSG 'CMD NOT VALID NOW ' 88 0 5 IUATRV *0675C AC MSG 'CMD NOT VALID ' 88 5 IUATRV *0680C 88 MSG 'CMD NOT VALID HERE' 5 IUATRV *0685C MSG 'CMD NOT DEFINED ' IUATRV *****C***************************************************************** *0689C &ABERR TAG UATRV *0690C MSG 'PUT DISABLED HERE ' UATRV *****C***************************************************************** *0691C &IOERR TAG IUATRV *0692C MOVE *ERROR #ERROR004 IUATRV *0693C '*ERROR 'DEBUG #ERROR IUATRV *0694C MSG 'I/O ERROR ' 8789 IUATRV *****C***************************************************************** *****C***************************************************************** *0710C &PUTJ TAG 5 A *0712C IMSG 'RESET/ENTER-ADD ' 5 A *0714C ACNKLNKH GOTO &BEG 5 A *----C*----------------------------------------------P6---------------- *----C*----------------------------------------------P7---------------- *----C*----------------------------------------------P8---------------- *0720C SETOF 01 5 A *0730C SETOF 02 5 A *0740C SETOF 03 5 A *----C*---------------------------------------------------------------- *0750C SETON 8988KJ 5 A *0755C SETOF KL 5 A *----C*--------------------------*2*9---------------------------------- *----C*----------------------------------------------F5---------------- *0800C @@##SV COMP '@@##' 87 5 A *0801C 87 SETON 01KL 5 A *0803C 87 GOTO &PUTN 5 A *----C*---------------------------------------------------------------- *****C***************************************************************** *0810C &PUTN TAG 5 A *0820C NKL 88 GOTO &ABERR 5 A *----C*--P9------------------------------------------M9---------------- *1000C 01 88 PUTN MS@@@@@@ 01 5 A *----C*---------------------------------------------------------------- *1010C 88 *ERROR COMP 42 KJKJ 5 A *1020C 88NKJ MSG 'DUPLICATE KEY ' 5 A *1030C 88 GOTO &IOERR 5 A *1040C GOTO &PUTT 5 A *****C***************************************************************** *****C***************************************************************** *1070C &PUTI TAG 5 UATR *1090C 89 MSG 'NO UPDATE RECORD ' 88 5 UATR *1100C IMSG 'RESET/ENTER-UPDATE' 5 UATR *1110C ACNKLNKH GOTO &BEG 5 UATR *****C***************************************************************** *****C***************************************************************** *1111C &REP TAG 6 5 UATRV *1120C MOVE CODESV PCNS 004 2 35 UATRV *1160C MOVE GCNS GCNM 002 2 35 UATRV *1170C MOVE PCNS PCNM 002 2 35 UATRV *1195C PCNM COMP ' ' KI 2 35 UATRV *1197C KWNKI GOTO &ERR 1 6 5 V *1200C N88 KW K1@@@@ COMP KYSV1@ 8888 1 6 5 UATRV *1201C N88 KW K2@@@@ COMP KYSV2@ 8888 1 6 5 UATRV *1202C N88 KW K3@@@@ COMP KYSV3@ 8888 1 6 5 UATRV *1203C KW KI MOVE KYSV1@ K1@@@@0010 1 6 5 UATRV *1204C KW KI MOVE KYSV2@ K2@@@@0020 1 6 5 UATRV *1205C KW KI MOVE KYSV3@ K3@@@@0030 1 6 5 UATRV *1207C KW 88 MSG 'KEY NOT VERIFIED ' 201 6 35 UATRV *1210C KWNKI PCNS COMP ' ' 88 201 6 35 UATR *1220C KWNKI 88 GOTO &ERR 201 6 35 UATR *1240C KWNKI GOTO &PUTT 201 6 35 UATR *1380C PCNM COMP GCNM 8888 2 35 UA *1390C 88 GCNM COMP ' ' 8888 2 35 UA *1420C 88 GOTO &ERR 2 35 UA *1430C SETON 8988KI 5 UA V *1440C PUT MS@@@@@@ 5 UA V *1450C 88 *ERROR COMP 33 KIKI 5 UA V *1460C 88NKI MSG 'KEY CHANGED ' 5 UA V *1470C 88 *ERROR COMP 8 KIKI 5 UA V *1480C 88NKI MSG 'NO GET BEFORE PUT ' 5 UA V *1490C 88 GOTO &IOERR 5 UA V *****C***************************************************************** *1495C &PUTT TAG 5 UATR *----C*----------------------------------------------T6---------------- *----C*----------------------------------------------T7---------------- *----C*----------------------------------------------T8---------------- *1500C SETOF 11 0 UATR *1501C SETOF 12 0 UATR *1502C SETOF 13 0 UATR *----C*---------------------------------------------------------------- *----C*--------------------------*2*9---------------------------------- *----C*----------------------------------------------*4---------------- *----C*----------------------------------------------F4---------------- *----C*----------------------------------------------*4---------------- *1520C @@##SV COMP '@@##' 87 0 UATR *1521C 87 SETON 11KL 0 UA *1522C 87NRR SETON 11KL 0 T *1523C 87 RR SETON 11KL 0 TR *1524C 87 GOTO &PUT 0 UATR *----C*---------------------------------------------------------------- *****C***************************************************************** *1530C &PUT TAG 0 UATR *1535C KWNKINKL GOTO &ABERR 0 6 5 UATR *1540C NKL 88 GOTO &ABERR 0 TR *1550C KL SETON 88 0 UATR *----C*--T9------------------------------------------T9---------------- *1600C 11 88 PUT TX@@@@@@ 11 0 UATR *----C*---------------------------------------------------------------- *1605C 88 PUT TX@@@@@@ 87 0 5 UA *1610C 88 GOTO &IOERR 0 UATR *----C*--P6----------------------P9------------------------------------ *----C*--P7----------------------P9------------------------------------ *----C*--P8----------------------P9------------------------------------ *1611C 01 MOVE '##' ##TYPE UATR *1612C 02 MOVE '##' ##TYPE UATR *1613C 03 MOVE '##' ##TYPE UATR *----C*---------------------------------------------------------------- *****C***************************************************************** *****C***************************************************************** *1614C &ACTH TAG 5 IUATRV *----C*----------------------------------------------*6---------------- *----C*----------------------------------------------*7---------------- *----C*----------------------------------------------*8---------------- *1615C SETOF 11 IUATRV *1616C SETOF 12 IUATRV *1617C SETOF 13 IUATRV *----C*---------------------------------------------------------------- *1618C SETON 8789 5 IUATRV *1619C KWNKI MSG 'RECORD WRITTEN ' 0 6 5 UATR *1620C KW MSG 'RECORD REPLACED ' 6 5 UATRV *1621C ACNKH GOTO &ACT 6 5 UATR * C*@@@@@@@ INSERT CHAIN *1622C AE KJ IN SETON KURS 0 5 AT *1625C NKUNKS SETON KH IUATRV *1636C GOTO &ACTT IUATRV *****C***************************************************************** *****C***************************************************************** *1640C &ACT TAG 5 IUATRV *1641C MOVELCODESV ##FORM002 2 5 IUATRV *1642C ##FORM COMP ' ' 88 2 5 IUATRV *1643C 88 MSG 'NO RESET INDICATOR' 2 5 IUATRV *----C*--------------------------*3----------------------*3------------ *1644C ##FORM COMP '##' 66 2 95 IUATRV *----C*---------------------------------------------------------------- *1646C SETOF 87 2 5 IUATRV *1647C SETON KY 2 5 IUATRV *****C***************************************************************** *****C***************************************************************** *1680C &ACTY TAG IUATRV *1690C MOVE ' ' VIEWCR IUATRV *----C*--*3----------------------*2------------------------------------ *1699C 66 MOVE '@@' VIEWCR 9 IUATRV *----C*---------------------------------------------------------------- *1710C GOTO &ACTT IUATRV *****C***************************************************************** *****C***************************************************************** *1720C &GET TAG 1 5 IUATRV *1730C SETON KX 1 5 IUATRV *1740C SETOF 8889 1 5 IUATRV *1750C KV GET MS@@@@@@ KX 1 6 5 IUATRV *1760C 88 GOTO &IOERR 1 6 5 IUATRV *1770C KX GET MS@@@@@@ 89 1 5 IUATRV *1780C 88 GOTO &IOERR 1 5 IUATRV *1790C 89 MSG 'RECORD NOT FOUND ' 88 1 5 IUATRV *1800C MOVE K1@@@@ KYSV1@0010 1 5 IUATRV *1810C MOVE K2@@@@ KYSV3@0020 1 5 IUATRV *1820C MOVE K3@@@@ KYSV3@0030 1 5 IUATRV *****C***************************************************************** *****C***************************************************************** *1840C &ACTX TAG IUATRV *1850C MOVE ' 'GCODES008 IUATRV *----C*--P6----------------------P2P9P4P5------------------------------ *----C*--P7----------------------P2P9P4P5------------------------------ *----C*--P8----------------------P2P9P4P5------------------------------ *1900C 01 MOVE '@@######'GCODES IUATRV *1901C 02 MOVE '@@######'GCODES IUATRV *1902C 03 MOVE '@@######'GCODES IUATRV *----C*---------------------------------------------------------------- *1904C MOVE GCODES GCNS 004 2 35 IUATRV *1906C MOVELGCODES GIDS 004 IUATRV *1907C KV MSG 'RECORD LOCATED ' 89 1 6 5 IUATRV *1908C MOVE GIDS ##TYPE002 IUATRV *1910C ##TYPE COMP ' ' 88 IUATRV *1950C 88 KK MSG 'RECORD READ ' 89 IUATRV *1964C MOVE ##TYPE VIEWCR002 IUATRV *****C***************************************************************** *1970C &ACTT TAG IUATRV *1972C MOVE @@##RT @@##RS004 2 6 5 IUATRV *1974C MOVE MODERT MODERS001 2 6 5 IUATRV *****C***************************************************************** *1980C &END TAG IUATRV *1990C SETON KG IUATRV *1998C PUTS @@BLANK@ IUATRV *1999CSR ENDSR IUATRV *****C***************************************************************** *****C***************** TRANSFER SUBROUTINE *************************** *****C***************************************************************** *2000CSR &XFRTN BEGSR IUATRV *2009C ES GOTO &OUT IUATRV *2010C EW GOTO &OUT IUATRV *2015C RV 87NRS GOTO &OUT 0 IUATRV *2028C NKGNIS PUTS PFORMT IUATRV *2030C NKG GOTO &PUTSU IUATRV *2035C SETOF KG IUATRV *2036C SETON KL IUATRV *2040C KH GOTO &PUTSP 2 IUATRV *2050C KX GOTO &PUTX 2 IUATRV *2060C KY GOTO &PUTY 2 IUATRV *2070C KQ GOTO &PUTQ 2 76 5 IUATRV *2080C KU GOTO &PUTRT 2 76 5 IUATRV *2090C KT GOTO &PUTRS 2 76 5 IUATRV *2110C MOVE @@##SV @@##CR004 2 IUATRV *2120C MOVE MODESV MODECR001 2 IUATRV *2130C KR GOTO &PUTCR 2 IUATRV *2140C KS GOTO &PUTCR 2 IUATRV *2170C &ACTCR TAG 2 76 5 IUATRV *2180C MODECR COMP 'R' KSKSKR 2 IUATRV *2185C SETON 88 2 76 5 IUATRV *2190C GOTO &PUTCR 2 76 5 IUATRV *****C***************************************************************** *****C***************************************************************** *2200C &PUTRT TAG 2 76 5 IUATRV *2210C MOVE @@##RT @@##CR004 2 76 5 IUATRV *2220C MOVE MODERT MODECR001 2 76 5 IUATRV *2240C GOTO &ACTCR 2 76 5 IUATRV *****C***************************************************************** *****C***************************************************************** *2250C &PUTRS TAG 2 76 5 IUATRV *2260C MOVE @@##RS @@##CR004 2 76 5 IUATRV *2270C MOVE MODERS MODECR001 2 76 5 IUATRV *2290C GOTO &ACTCR 2 76 5 IUATRV *****C***************************************************************** *****C***************************************************************** *2330C &PUTCR TAG 2 IUATRV *2360C KR MOVE @@##CR VIEWCR 2 IUATRV *2370C KS MOVEL@@##CR VIEWCR 2 IUATRV *2380C KR MOVE 'R' MODECR 2 IUATRV *2390C KS MOVE 'S' MODECR 2 IUATRV *****C***************************************************************** *****C***************************************************************** *2400C &PUTQ TAG 2 IUATRV *2410C SETON KQ IUATRV *----C*--------------------------*2------------------------------------ *----C*-------------------------*1*2----------------------------------- *2500C VIEWCR COMP '@@' KW 9 IUATRV *2501C KW PUTS F@@@@@@@ 9 IUATRV *----C*---------------------------------------------------------------- *----C*--------------------------*9------------------------------------ *----C*-------------------------*1*9----------------------------------- *2600C VIEWCR COMP '##' KV IUATRV *2601C KV PUTS M@@@@@@@ IUATRV *----C*---------------------------------------------------------------- *2610C GOTO &PUTSU IUATRV *****C***************************************************************** *****C***************************************************************** *2620C &PUTY TAG 2 IUATRV *2670C MOVE 'S' MODECR 2 IUATRV *----C*--*3---------------------*1------------------------------------- *2700C 66 PUTS F@@@@@@@ 2 9 IUATRV *----C*---------------------------------------------------------------- *2710C GOTO &PUTSU 2 IUATRV *****C***************************************************************** *2720C &PUTX TAG 2 IUATRV *2730C MOVE 'R' MODECR 2 IUATRV *----C*--*6---------------------*1------------------------------------- *----C*--*7---------------------*1------------------------------------- *----C*--*8---------------------*1------------------------------------- *2800C 01 PUTS M@@@@@@@ 2 IUATRV *2801C 02 PUTS M@@@@@@@ 2 IUATRV *2802C 03 PUTS M@@@@@@@ 2 IUATRV *----C*---------------------------------------------------------------- *2803C GOTO &PUTSU 2 IUATRV *****C***************************************************************** *****C***************************************************************** *2835C &PUTSP TAG IUATRV *2836C MOVE *BLANK @@##RS 2 IUATRV *2837C MOVE *BLANK MODERS 2 IUATRV *2838C MOVE *BLANK @@##RT 2 IUATRV *2839C MOVE *BLANK MODERT 2 IUATRV *2840C MOVE ##TYPE VIEWCR002 IUATRV *2842C MOVE 'R' MODECR001 IUATRV *****C***************************************************************** *****C***************************************************************** *2844C &PUTSU TAG IUATRV *2846C SETON KQKG IUATRV *2850C PUTS P@@@@@@ IUATRV *****C***************************************************************** *2897C &OUT TAG IUATRV * C*@@@@@@@ DELETE *2898C NAE DL GOTO &PUTSU 0 IUATR *2899CSR ENDSR IUATRV