Retro1.org codex

          IDENT  BAAML 
          SST
          ENTRY  CLOSE
          ENTRY  DBCOMIT
          ENTRY  DBEGIN
          ENTRY  DBFREE
          ENTRY  DBSTAT
          ENTRY  DELETE
          ENTRY  FLOCK
          ENTRY  LOCK
          ENTRY  OPEN
          ENTRY  READ
          ENTRY  READL
          ENTRY  READM
          ENTRY  READNL
          ENTRY  READN
          ENTRY  REWIND
          ENTRY  REWRITE
          ENTRY  SKIPBL
          ENTRY  SKIPFL
          ENTRY  START
          ENTRY  UNFLOCK
          ENTRY  UNLOCK
          ENTRY  WRITE
          SYSCOM B1
          TITLE  BAAML - OBJECT TIME BATCH CONCURRENCY.
*COMMENT BAAML -  OBJECT TIME BATCH CONCURRENCY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 BAAML    SPACE  4,10
***       BAAML - OBJECT TIME BATCH CONCURRENCY.
*
*         P. H. PETERSEN.          81/01/13.
          SPACE  4,10
***       BAAML IS AN USER LIBRARY INTERFACE FOR COBOL5 AND FORTRAN
*         BATCH USER PROGRAMS TO MAKE ADVANCED ACCESS METHOD CYBER
*         RECORD MANAGER REQUESTS OF THE TRANSACTION FACILITY.  DECK
*         *BAAML*  IS PLACED ON THE SYSTEM AS LIBRARY *BAAML*.  COBOL5
*         *ENTER* VERB AND FORTRAN *CALL* COMMAND INTERFACE THE
*         USER BATCH PROGRAMS TO THE TRANSACTION FACILITY.
*
*         THE REQUESTS FOR *TAF CMR* ARE AS FOLLOWS -
*
*         TO CLOSE A FILE FOR A DATA BASE -
*         ENTER "CLOSE" USING FILE,TSTAT,CSTAT.
*         CALL CLOSE (FILE,TSTAT,CSTAT).
*
*         TO MARK THE END OF AN UPDATE SEQUENCE -
*         ENTER "DBCOMIT" USING TSTAT.
*         CALL DBCOMIT (TSTAT).
*
*         TO ESTABLISH A DATA BASE AS RECOVERABLE -
*         ENTER "DBEGIN" USING UBEGIN, TSTAT.
*         CALL DBEGIN (UBEGIN, TSTAT).
*
*         TO ROLLBACK UPDATES TO A DATA BASE -
*         ENTER "DBFREE" USING TSTAT.
*         CALL DBFREE (TSTAT).
*
*         TO FIND LAST IDENTIFIER OF LAST SUCCESSFULL BEGIN/COMMIT -
*         ENTER "DBSTAT" USING UBEGIN, TSTAT, PBEGIN.
*         CALL DBSTAT (UBEGIN, TSTAT, PBEGIN).
*
*         TO DELETE A RECORD -
*         ENTER "DELETE" USING FILE,TSTAT,CSTAT,KEYN,KEYP.
*         CALL DELETE (FILE,TSTAT,CSTAT,KEYN,KEYP).
*
*         TO LOCK A RECORD -
*         ENTER "LOCK" USING FILE,TSTAT,KEYN,KEYP.
*         CALL LOCK (FILE,TSTAT,KEYN,KEYP).
*
*         TO LOCK A FILE -
*         ENTER "FLOCK" USING FILE,TSTAT.
*         CALL FLOCK (FILE,TSTAT).
*
*         TO OPEN A FILE FOR A DATA BASE -
*         ENTER "OPEN" USING FILE,TSTAT,CSTAT.
*         CALL OPEN (FILE,TSTAT,CSTAT).
*
*         TO READ A RECORD BY KEY -
*         ENTER "READ" USING FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYN,KEYP,
*                KSTAT,KEYID,KEYA,KEYL.
*         CALL READ (FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYN,KEYP,
*                KSTAT,KEYID,KEYA,KEYL).
*
*         TO READ A RECORD BY KEY WITH LOCK -
*         ENTER "READL" USING FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYN,KEYP,
*                KSTAT,KEYID,KEYA,KEYL.
*         CALL READL (FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYN,KEYP,
*                KSTAT,KEYID,KEYA,KEYL).
*
*         TO READ A RECORD BY MAJOR KEY -
*         ENTER "READM" USING FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYA,
*                KEYRL,KEYN,KEYP,MKEYL,KSTAT,KEYID.
*         CALL READM (FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYA,
*                KEYRL,KEYN,KEYP,MKEYL,KSTAT,KEYID).
*
*         TO READ NEXT RECORD -
*         ENTER "READN" USING FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYR,KEYL,
*                KSTAT.
*         CALL READN (FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYR,KEYL,KSTAT).
*
*         TO READ NEXT RECORD WITH LOCK -
*         ENTER "READNL" USING FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYR,KEYL,
*                 KSTAT.
*         CALL READNL (FILE,TSTAT,CSTAT,WSA,WSAL,RL,KEYR,KEYL,KSTAT).
*
*         TO REWIND A FILE -
*         ENTER "REWIND" USING FILE,TSTAT,CSTAT.
*         CALL REWIND (FILE,TSTAT,CSTAT).
*
*         TO REWRITE A RECORD -
*         ENTER "REWRITE" USING FILE,TSTAT,CSTAT,WSA,RL,KEYN,KEYP.
*         CALL REWRITE (FILE,TSTAT,CSTAT,WSA,RL,KEYN,KEYP).
*
*         TO SKIP A LOGICAL RECORD BACKWARD -
*         ENTER "SKIPBL" USING FILE,TSTAT,CSTAT,COUNT.
*         CALL SKIPBL (FILE,TSTAT,CSTAT,COUNT).
*
*         TO SKIP A LOGICAL RECORD FORWARD -
*         ENTER "SKIPFL" USING FILE,TSTAT,CSTAT,COUNT.
*         CALL SKIPFL (FILE,TSTAT,CSTAT,COUNT).
*
*         TO ESTABLISH A POSITION ON A FILE -
*         ENTER "START" USING FILE,TSTAT,CSTAT,RELOP,KEYN,KEYP,KSTAT,
*                KEYID,MKEYL.
*         CALL START (FILE,TSTAT,CSTAT,RELOP,KEYN,KEYP,KSTAT,
*                KEYID,MKEYL.
*
*         TO UNLOCK A RECORD -
*         ENTER "UNLOCK" USING FILE,TSTAT,KEYN,KEYP.
*         CALL UNLOCK (FILE,TSTAT,KEYN,KEYP).
*
*         TO UNLOCK A FILE -
*         ENTER "UNFLOCK" USING FILE,TSTAT.
*         CALL UNFLOCK (FILE,TSTAT).
*
*         TO WRITE A RECORD -
*         ENTER "WRITE" USING FILE,TSTAT,CSTAT,WSA,RL,KEYN,KEYP.
*         CALL WRITE (FILE,TSTAT,CSTAT,WSA,RL,KEYN,KEYP).
*
*         THE PARAMETERS FOR *TAF CRM* REQUESTS ARE DEFINED BELOW -
*
*         XXPFNI (FILE) - FILE NAME SELECTED BY DATA BASE ADMINIS-
*                TRATOR.  THE FILE NAME MUST BEGIN ON A WORD BOUNDARY
*                AND CONSIST OF 2-7 CHARACTERS WITH BLANK OR BINARY
*                ZERO FILL.
*                COBOL5 - 01 LEVEL DATA NAME.
*                FORTRAN - INTEGER.
*
*         TAF-STATUS (TSTAT) - TRANSACTION FACILTY STATUS.
*                SEE DECK *COMKTER.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         CRM-STATUS (STAT) - ERROR CODE STATUS FOR *CRM*.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         WSA-NAME (WSA) - SPECIFIES THE AREA TO CONTAIN THE RECORD.
*                COBOL5 - 01 LEVEL DATA NAME.
*                FORTRAN - INTEGER ARRAY.
*
*
*         WSA-LENGTH (WSAL) - SPECIFIES THE LENGTH OF THE AREA
*                IDENTIFIED BY THE WSA-NAME.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-AREA (KEYA) - SPECIFIES THE FIELD TO CONTAIN THE
*                PRIMARY KEY RETURNED ON A READ REQUEST.
*                COBOL5 - 01 LEVEL DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-AREA-LENGTH (KEYAL) - THE LENGTH OF THE FIELD IDENTIFIED
*                BY THE KEY-AREA PARAMETER.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         MAJOR-KEY-LENGTH (MKEYL) - THE  LENGTH OF THE MAJOR KEY.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-OFFSET (KEYP) - THE BEGINNING POSITION OF THE
*                PRIMARY KEY.
*                COBOL5 - 01 COMPUTATIONAL-1  DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-NAME (KEYN) - DATA NAME THE CONTAINS THE PRIMARY KEY.
*                COBOL5 - 01 LEVEL DATA NAME.
*                FORTRAN - INTEGER.
*
*         RECORD-LENGTH (RL) - DATA NAME THE SPECIFIES THE LENGTH
*                OF THE RECORD RETURNED BY *TAF* AFTER ISSUING
*                A READ REQUEST.  ALSO, THE LENGTH OF THE RECORD
*                TO BE WRITTEN TO THE DATA BASE FROM THE AREA
*                IDENTIFIED BY THE WSA-NAME PARAMETER.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         COUNT - COUNT OF LOGICAL RECORDS TO SKIP.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-STATUS (KSTAT) - DATA NAME THAT SPECIFIES THE FIELD TO
*                CONTAIN A KEY STATUS CODE RETURNED BY *TAF*.
*                COBOL5 - 01 LEVEL COMPUTATIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         KEY-IDENTIFIER (KEYID) - A DATA NAME THE SPECIFIES
*                THE KEY, ALTERNATE OR PRIMARY, FOR ACCESS.
*
*                NEGATIVE -  NO CHANGE IN KEY ACCESS.
*                       0 -  PRIMARY KEY.
*                       N -  VALUE ASSOCIATED WITH THE
*                           KEY BY AN *AKY* COMMAND.
*                COBOL5 - 01 LEVEL COMPUTIONAL DATA NAME.
*                FORTRAN - INTEGER.
*
*         RELATION-OPERATOR (RELOP) - VALUES EQ, GT, OR GE.
*                A DATA NAME THAT SPECIFIES THE POSITION RELATIVE
*                TO THE GIVEN KEY AFTER THE OPERATION.
*                COBOL5 - 01 LEVEL COMPUTATION-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         UBEGIN - A JOB SUPPLIED VALUE TO DEFINE A
*                RESTART POSITION.
*                COBOL5 - 01 LEVEL COMPUTIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
*         PBEGIN - THE BEGINNING IDENTIFIER OF THE
*                PREVIOUS *DBEGIN* REQUEST.
*                COBOL5 - 01 LEVEL COMPUTIONAL-1 DATA NAME.
*                FORTRAN - INTEGER.
*
          SPACE  4,20
***       DAYFILE MESSAGES.
*
*         TAF FUNCTION CODE NOT VALID.
*                TAF CANNOT PROCESS THE REQUEST ISSUED BECAUSE
*                IT IS AN UNRECOGNIZABLE FUNCTION CODE.  THIS IS
*                AN INTERNAL ERROR.
*
*
*         TAF TWO OUTSTANDING REQUEST.
*                TAF RECIEVED ANOTHER REQUEST FROM A USER PROGRAM
*                BEFORE THE PREVIOUS REQUEST WAS SATISFIED.  THIS
*                IS AN INTERNAL ERROR.
*
*
*         TAF SUBSYSTEM BUSY.
*                TAF WAS BUSY AND COULD NOT ACCEPT THE BATCH REQUEST.
*
*
*         TAF/CRM FUNCTION CODE NOT VALID.
*                *TAF/CRM* CANNOT PROCESS THE REQUEST ISSUED BECAUSE
*                IT IS AN UNRECOGNIZABLE FUNCTION CODE.  THIS
*                IS AN INTERNAL ERROR.
*
*
*         TAF USER NOT VALID FOR TAF ACCESS.
*                BATCH USER WAS NOT VALIDATED TO USE *TAF*.
*
*
*         TAF USER NAME ACTIVE.
*                SOME OTHER BATCH OR TERMINAL JOB IS CURRENTLY
*                ACCESSING *TAF/CRM* UNDER THIS USER NAME.
*
*
*         TAF DATA NOT WITHIN UCP FL.
*                TAF CANNOT READ (WRITE) DATA FROM USER PROGRAM
*                BECAUSE THE ADDRESS SPECIFIED IS OUTSIDE THE
*                *UCP* (USER CONTROL POINT) *FL* (FIELD LENGTH).
*
*
*         TAF/CRM TAF STATUS ERROR XXXX IN FUNCTION YYYYYYY.
*                AN TAF-STATUS ERROR CODE NNN WAS RETURNED TO
*                THE PROGRAM FROM FUNCTION XXXXXXX.
*
*
*         TAF/CRM CRM STATUS ERROR XXXX IN FUNCTION YYYYYYY.
*                AN CRM-STATUS ERROR CODE NNN WAS RETURNED TO
*                THE PROGRAM FROM FUNCTION XXXXXXX.
*
*         TAF USER CONFLICT IN ACCESS TYPE.
*                BATCH JOB TRIED TO ACCESS AS INTERACTIVE.
*
*         TAF ERROR CODE NOT DEFINED.
*                *BAAML* COULD NOT FIND PROPER ERROR CODE.
*
*         TAF RECOVERY REQUEST ERROR.
*                TAF DETECTED AN ERROR IN THE RECOVERY REQUEST.
*
*         BATCH CONCURRENCY DISABLED.
*                TAF WAS NOT INITIALIZED WITH BATCH CONCURRENCY
*                ENABLED.
*
*         TAF/CRM DATA MANAGER NOT LOADED IN TAF.
*                THE CRM DATA MANAGER WAS NOT LOADED WHEN
*                TAF WAS INITIALIZED.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         TAF IDLE (GO OR DROP).
*                ACCESS TO *TAF* DENIED BECAUSE IT IS IDLING DOWN.
*
*         TAF SUBSYSTEM NOT PRESENT (GO OR DROP).
*                THE *TAF* SUBSYSTEM WAS NOT PRESENT WHEN A BATCH
*                JOB TRIED TO CONNECT TO IT.
          SPACE  4,10
**        FCTM - FUNCTION CODE TABLE ERROR.
*
*         *FCTM* IS A MACRO THAT IS USED TO BUILD A TABLE
*         FOR PROCESSING THE RESPONSE FROM *TAF/CRM*.
*
*         ENTRY  FCTM  MSG,RUT,DSP,ERC
*                MSG - MESSAGE TO BE ISSUED.
*                RUT - ROUTINE TO DO THE PROCESSING.
*                DSP - DISPLAY MESSAGE TO PROPER DAYFILE.
*                ERC - ERROR CODE RESPONSE.
 
 
 FCTM     MACRO  MSG,RUT,DSP,ERC
          VFD    18/MSG,18/RUT,6/DSP,18/ERC
 FCTM     ENDM
          SPACE  4,10
***       COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMKTRN
*CALL     COMKTDM
*CALL     COMKIPR
          LIST   X
*CALL     COMKFLD
*CALL     COMKTSC
 BEGNX    BSS    0
*CALL     COMKCRM
*CALL     COMKTER
          ORG    BEGNX       DO NOT RESERVE SPACE FOR *TAF/CRM* TABLES
          QUAL   SCP
*CALL     COMSSCP
          QUAL   SSD
*CALL     COMSSSD
          QUAL
          LIST   -X
          TITLE  SUB-FUNCTION FOR *CRM* CALLS.
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 TCHL     EQU    10          NUMBER OF CHARACTERS IN A WORD
 
 TMKL     EQU    255         MAXIMUN LENGTH OF A KEY IN CHARACTERS
 
 TMKW     EQU    24          MAXIMIN LENGTH OF A KEY IN WORDS
 
 THRL     EQU    2           LENGTH OF PACKET HEADER
          EJECT
 CLOSE    SPACE  4,15
**        CLOSE - CLOSE A FILE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   *TAF* AND *CRM* STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTS.
 
 
 CLOSE    SUBR               ENTRY/EXIT
          SB2    TPCLL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRCL        CLOSE SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     CLOSEX      RETURN
 DBCOMIT  SPACE  4,15
**        DBCOMIT - MARK END OF UPDATE SEQUENCE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE.
*
*         USES   X - 1, 2, 7.
*                A - 1, 2, 7.
*                B - 2.
*
*         CALLS  PRT, DCF.
 
 
 DBCOMIT  SUBR               ENTRY/EXIT
          SB2    TPDCL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRDC        SUB-FUNCTION CODE
          RJ     DCF         PROCESS REQUEST
          EQ     DBCOMITX    RETURN
 DBEGIN   SPACE  4,15
**        DBEGIN - DESIGNATE A DATA BASE AS RECOVERABLE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 1, 2, 7.
*                A - 1, 2, 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTT.
 
 
 DBEGIN   SUBR               ENTRY/EXIT
          SB2    TPDBL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRDB        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          SA2    TPKT+THRL+TPTS  TAF-STATUS FROM AAMI
          ZR     X2,DBN1     IF NO ERRORS
          BX1    X2
          RJ     RTT         ISSUE ERROR MESSAGE
 DBN1     SX7    B6-TPDBL    NUMBER OF PARAMTERS
          NG     X7,DBEGINX  IF NOT ENOUGH PARAMTERS
          SA2    A1+TPTS     ADDRESS TO PUT TAF-STATUS
          SA1    TPKT+THRL+TPTS  TAF-STATUS
          BX7    X1
          SA7    X2          SET TAF-STATUS
          EQ     DBEGINX     RETURN
 DBFREE   SPACE  4,15
**        DBFREE - ROLLBACK ALL UPDATES TO A FILE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 1, 2, 7.
*                A - 1, 2, 7.
*                B - 2.
*
*         CALLS  PRT, DCF.
 
 
 DBFREE   SUBR               ENTRY/EXIT
          SB2    TPDFL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRDF        SUB-FUNCTION CODE
          RJ     DCF         PROCESS REQUEST
          EQ     DBFREEX     RETURN
 DBSTAT   SPACE  4,15
**        DBSTAT - FIND LAST BEGIN/COMMIT SEQUENCE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 1, 2, 3, 7.
*                A - 2, 3, 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTT.
 
 
 DBSTAT   SUBR               ENTRY/EXIT
          SB2    TPDSL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRDS        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          SX7    B6-TPDSL    PARAMETERS
          NG     X7,DBS1     IF NOT ENOUGH PARAMETERS
          SA2    A1+TPPI     PREVIOUS DBCOMIT STATUS
          SA2    X2          VALUE
          BX7    X2
          SA7    TPKT+THRL+TPPI  PREVIOUS DBCOMIT STATUS
 DBS1     RJ     RQS         ISSUE *TAF/CRM* REQUEST
          SA2    TPKT+THRL+TPTS  TAF-STATUS FROM AAMI
          ZR     X2,DBS2     IF NO ERRORS
          BX1    X2
          RJ     RTT         ISSUE ERROR MESSAGE
 DBS2     SX7    B6-TPDSL    MINIMUM NUMBER OF PARAMETERS
          NG     X7,DBSTATX  IF NOT ENOUGH PARAMETERS
          SA3    TPKT+THRL+TPCI  DBSTAT FROM *TAF/CRM*
          SA2    A1+TPCI     DBSTAT ADDRESS
          BX7    X3
          SA7    X2
          SA3    TPKT+THRL+TPTS  TAF-STATUS
          SA2    A1+TPTS     TAF-STATUS ADDRESS
          BX7    X3
          SA7    X2
          SA3    TPKT+THRL+TPPI  DBSTAT FROM *TAF/CRM*
          SA2    A1+TPPI     DBSTAT ADDRESS
          BX7    X3
          SA7    X2
          EQ     DBSTATX     RETURN
 DELETE   SPACE  4,15
**        DELETE - DELETE A RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND ADDRESS RETURNED.
*
*         USES   X - 7.
*                A - 7.
*                B - 2, 4.
*
*         CALLS  CKF, PRT, RQS, RTS.
 
 
 DELETE   SUBR               ENTRY/EXIT
          SB2    TPDEL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRDE        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          SX7    B6-TPDEL    MINIMUM NUMBER OF PARAMETERS
          NG     X7,DEL1     IF NOT ENOUGH PARAMETERS
          SB4    0           SET NO MAJOR KEY-LENGTH
          SB2    TPDK        INDEX TO KEY-AREA IN PATAMERER LIST
          RJ     CKF         CHECK AND TRANSFER KEY
          NZ     X7,DEL2     IF KEY-OFFSET ERROR
 DEL1     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 DEL2     RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     DELETEX     RETURN
 FLOCK    SPACE  4,15
**        FLOCK - LOCK A FILE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTS.
 
 
 FLOCK    SUBR               ENTRY/EXIT
          SB2    TPLFL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRLF        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     FLOCKX      RETURN
 LOCK     SPACE  4,15
**        LOCK - LOCK RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 1, 2, 7.
*                A - 1, 2, 7.
*                B - 2, 4.
*
*         CALLS  PRT, RQS, CKF, RTT.
 
 
 LOCK     SUBR               ENTRY/EXIT
          SB2    TPLCL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRLC        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          SX7    B6-TPLCL    MINIMUM NUMBER OF PARAMETERS
          NG     X7,LOK1     IF NOT ENOUGH PARAMETERS
          SB2    TPKL        INDEX FOR KEY-NAME TO PARAMETER LIST
          SB4    0           SET NO MAJOR-KEY-LENGTH
          RJ     CKF         CHECK AND TRANSFER KEY
          NZ     X7,LOK2     IF KEY-OFFSET ERRORS
 LOK1     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 LOK2     SA2    TPKT+THRL+TPTS  TAF-STATUS FROM AAMI
          ZR     X2,LOK3     IF NO ERRORS
          BX1    X2
          RJ     RTT         ISSUE ERROR MESSAGE
 LOK3     SX7    B6-TPPI     MINIMUM NUMBER OF PARAMETERS
          NG     X7,LOCKX    IF NOT ENOUGH PARAMETERS
          SA2    A1+TPTS     ADDRESS TO RETURN DBSTAT
          SA1    TPKT+THRL+TPTS  TAF-STATUS FROM DBSTAT
          BX7    X1
          SA7    X2          TAF-STATUS TO PROGRAM
          EQ     LOCKX       RETURN
 OPEN     SPACE  4,15
**        OPEN - OPEN DATA BASE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT    FUNCTION COMPLETE AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTS.
 
 
 OPEN     SUBR               ENTRY/EXIT
          SB2    TPOPL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TROP        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUES *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     OPENX       RETURN
 READ     SPACE  4,15
**        READ - READ BY KEY.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         EXIT   READ FUNCTIN COMPLETE AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS  RAD.
 
 
 READ     SUBR               ENTRY/EXIT
          SB2    TPRDL       MAXIMIM NUMBER OF PARAMETERS
          SX7    TRRD        SUB-FUNCTION CODE
          RJ     RAD         PROCESS READ AND READL FUNCTIONS
          EQ     READX       RETURN
 READL    SPACE  4,15
**        READL -  READ AND LOCK RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS   RAD.
 
 
 READL    SUBR               ENTRY/EXIT
          SB2    TPRLL       MAXIMUM PARAMETERS FOR READ
          SX7    TRRL        SUB-FUNCTION CODE
          RJ     RAD         PROCESS READ AND READL FUNCTIONS
          EQ     READLX      RETURN
 READM    SPACE  4,15
**        READM - READ BY MAJOR KEY.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 0, 7.
*                B - 2.
*
*         CALLS RDM.
 
 
 READM    SUBR               ENTRY/EXIT
          SB2    TPRML       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRRM        SUB-FUNCTION CODE
          SX0    TRRM        SET SWITCH FOR CALL BY READM
          RJ     RDM         PROCESS READM FUNCTION
          EQ     READMX      RETURN
 READNL   SPACE  4,15
**        READNL - READ NEXT RECORD WITH LOCK.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 0, 7.
*                B - 2.
*
*         CALLS  RDM.
 
 
 READNL   SUBR               ENTRY/EXIT
          SX7    TRRO        SUB-FUNCTION CODE
          SB2    TPROL       MAXIMUM NUMBER OF PARAMETERS
          SX0    0           INDICATE NOT CALLED BY READM
          RJ     RDM         PROCESS READNL FUNCTION
          EQ     READNLX     RETURN
 READN    SPACE  4,15
**        READN - READ NEXT RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 0, 7.
*                B - 2.
*
*         CALLS  RDM.
 
 
 READN    SUBR               ENTRY/EXIT
          SB2    TPRNL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRRN        SUB-FUNCTION CODE
          SX0    0           INDICATE NOT CALLED BY READM
          RJ     RDM         PROCESS READN FUNCTION
          EQ     READNX      RETURN
 REWIND   SPACE  4,15
**        REWIND - REWIND FILE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS   PRT, RQS, RTS.
 
 
 REWIND   SUBR               ENTRY/EXIT
          SB2    TPRPL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRRP        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     REWINDX     RETURN
 REWRITE  SPACE  4,15
**        REWRITE - REWRITE RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS    WRR.
 
 
 REWRITE  SUBR               ENTRY/EXIT
          SB2    TPRWL       MAXIMUM NUMBER OF PARAMETER
          SX7    TRRW        SUB-FUNCTION
          RJ     WRR         REWRITE RECORD
          EQ     REWRITEX    RETURN
 SKIPBL   SPACE  4,15
**        SKIPBL - SKIP BACKWARD LOGICAL RECORDS.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS   SKP.
 
 
 SKIPBL   SUBR               ENTRY/EXIT
          SB2    TPSBL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRSB        SUB-FUNCTION CODE
          RJ     SKP         PROCESS SKIP FUNCTION
          EQ     SKIPBLX     RETURN
 SKIPFL   SPACE  4,15
**        SKIPFL - SKIP FORWARD LOGICAL RECORDS.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS   SKP.
 
 
 SKIPFL   SUBR               ENTRY/EXIT
          SB2    TPSFL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRSF        SUB-FUNCTION FOR *TAF/CRM*
          RJ     SKP         PROCESS SKIP FUNCTION
          EQ     SKIPFLX     RETURN
 START    SPACE  4,15
**        START - POSITION A FILE AT OR AFTER A GIVEN KEY.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 3, 7.
*                A - 2, 3, 7.
*                B - 4.
*
*         CALLS   CKF, PRT, RQS, RTS.
 
 
 START    SUBR               ENTRY/EXIT
          SB2    TPSTL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRST        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          SX1    B6-TPSTF    REQUIRED NUMBER OF PPARAMETERS
          NG     X1,SRT2     IF NOT ENOUGH PARAMETERS
          SA2    A1+TPSR     RELATION-OPERATOR
          SB4    0
          SA2    X2          VALUE OF RELATION-OPERATOR
          BX7    X2
          SX1    B6-TPSM     PARAMETERS
          SA7    TPKT+THRL+TPSR  RELATION-OPERATOR TO PACKET
          NG     X1,SRT1     IF END OF PARAMETERS
          SA2    A1+TPSO     KEY-IDENTIFIER
          SA2    X2          VALUE
          BX7    X2
          SA7    TPKT+THRL+TPSO  KEY-IDENTIFIER TO PACKET
          ZR     X1,SRT1     IF END OF PARAMETERS
          SA2    A1+TPSM     MAJOR-KEY-INDEX
          SA2    X2
          BX7    X2
          SB4    X2+
          SA7    TPKT+THRL+TPSM  MAJOR-KEY-LENGTH TO PACKET
 SRT1     SB2    TPSK        KEY-AREA INDEX
          RJ     CKF         TRANSFER KEY
          NZ     X7,SRT3     IF KEY-OFFSET ERROR
 SRT2     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 SRT3     RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          SX2    B6-TPSTF    REQUIRED PARAMETER
          NG     X2,STARTX   IF NOT ENOUGH PARAMETERS
          ZR     X2,STARTX   IF END OF PARAMETERS
          SA2    A1+TPSF     KEY-STATUS ADDRESS
          SA3    TPKT+THRL+TPSF  KEY-STATUS
          BX7    X3
          SA7    X2
          EQ     STARTX      RETURN
 UNFLOCK  SPACE  4,15
**        UNFLOCK - UNLOCK FILE.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS   PRT, RQS, RTS.
 
 
 UNFLOCK  SUBR               ENTRY/EXIT
          SB2    TPUFL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRUF        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     UNFLOCKX    RETURN
 UNLOCK   SPACE  4,15
**        UNLOCK - UNLOCK RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 7.
*                A - 1, 2, 7.
*                B - 2, 4.
*
*         CALLS  PRT, CKF, RQS, RTT.
 
 UNLOCK   SUBR               ENTRY/EXIT
          SB2    TPUCL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRUC        SUB-FUNCTION CODE
          RJ     PRT         PRESET
          SX7    B6-TPUCL    CHECK NUMBER OF PARAMETERS
          NG     X7,UNL1     IF NOT ENOUGH PARAMETERS
          SB2    TPKL        KEY POSITION
          SB4    0           SET NO MAJOR-KEY-LENGTH
          RJ     CKF         TRANSFER KEY
          NZ     X7,UNL2     IF KEY-OFFSET ERRORS
 UNL1     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 UNL2     SA2    TPKT+THRL+TPTS  TAF-STATUS FROM AAMI
          ZR     X2,UNL3     IF NO ERRORS
          BX1    X2
          RJ     RTT         ISSUE ERROR MESSAGE
 UNL3     SX7    B6-TPPI     MINIMUM NUMBER OF PARAMETERS
          NG     X7,UNLOCKX  IF NOT ENOUGH PARAMETERS
          SA2    A1+TPTS     ADDRESS TO RETURN DBSTAT
          SA1    TPKT+THRL+TPTS  TAF-STATUS FROM DBSTAT
          BX7    X1
          SA7    X2          TAF-STATUS TO PROGRAM
          EQ     UNLOCKX     RETURN
 WRITE    SPACE  4,15
**        WRITE - WRITE RECORD.
*
*         ENTRY  (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 7.
*                B - 2.
*
*         CALLS    WRR.
 
 
 WRITE    SUBR               ENTRY/EXIT
          SB2    TPWRL       MAXIMUM NUMBER OF PARAMETERS
          SX7    TRWR        SUB-FUNCTION CODE
          RJ     WRR         WRITE A RECORD
          EQ     WRITEX      RETURN
          TITLE  UTILITIES FOR *CRM* FUNCTIONS.
 CKF      SPACE  4,20
**        CKF - CHECK KEY FIELD LENGTH.
*
*         ENTRY  (TSA1) = POINTER TO PARAMETER LIST.
*                (A1) = ADDRESS OF PARAMETER LIST.
*                (B2) = INDEX OF PARAMETER LIST FOR KEY-NAME.
*                (B3) = INDEX OF PACKET FOR KEY-NAME ADDRESS.
*                (B4) = MAJOR-KEY-LENGTH IF NON-ZERO.
*
*         EXIT   (TPKT+15) = KEY.
*                (X7) - ZERO, NO ERRORS.
*                (X7) - NON-ZERO, IF ERROR IN KEY-OFFSET.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 2, 4.
*
*         MACRO  GETFLC.
*
*         CALL   MST.
 
 
 CKF      SUBR               ENTRY/EXIT
          SA3    A1+B2       KEY-NAME ADDRESS
          SA2    A3+B1       KEY-OFFSET
          SA2    X2          VALUE OF KEY-OFFSET
          SX3    X3          ADDRESS ONLY
          ZR     X2,CKF3     IF KEY-OFFSET ZERO
          NG     X2,CKF3     IF KEY-OFFSET IS NEGATIVE
          SX1    TCHL        NUMBER OF CHARACTERS IN A WORD
          BX7    X1
          BX6    X2
          IX6    X6/X7       NUMBER OF WORDS TO KEY-NAME
          IX7    X6+X3       ADDRESS PLUS NUMBER OF WORDS
          IX1    X1*X6       NUMBER OF CHARACTERS TO KEY-OFFSET
          IX2    X2-X1       KEY-OFFSET
          SX6    B1
          SA7    TPKT+THRL+B2  KEY-NAME ADDRESS
          SA6    A7+B1       SET KEY-OFF TO ONE FOR *TAF/CRM*
          SB2    X2          KEY-OFFSET FOR MOVE
          SX3    X7+         KEY-NAME ADDRESS FOR MOVE
          GETFLC CKFA        FIELD LENGTH OF JOB
          SA2    CKFA        MEMORY VALUE
          MX1    12          MASK FOR FIELD CENTRAL MEMORY
          BX2    X2*X1
          SX7    X7+TMKW     ADDRESS OF KEY-NAME PLUS KEY
          LX2    17-59       POSITION FIELD LENGTH
          IX7    X7-X2       SUBTRACT KEY-NAME PLUS KEY SIZE
          NE     B4,CKF1     IF NOT MAJOR-KEY-LENGTH
          SB4    TMKL        MAXIMUM LENGTH OF KEY
 CKF1     NG     X7,CKF2     IF KEY-NAME ADDRESS NOT TO LARGE
          SB4    TCHL        REDUCE KEY MOVE TO ONE WORD
 CKF2     SB5    TKEY        ADDRESS TO TRANSFER KEY
          SA2    X3          KEY-NAME TRANSFER
          SB2    B2-B1
          RJ     MST         MOVE KEY INTO PACKET
          BX7    X7-X7       SET NO ERRORS
          EQ     CKFX        RETURN
 
 CKF3     SX7    TERQ        INVALID KEY-OFFSET
          SA7    TPKT+THRL+TPCS  *TAF/CRM* ERROR STATUS SET
          EQ     CKFX        RETURN
 
 
 CKFA     BSSZ   1           FIELD LENGTH OF PROGRAM
 CWS      SPACE  4,15
**        CWS - CALCULATE *WSA* LENGTH.
*
*         ENTRY  (A1) = PARAMETER LIST ADDRESS.
*
*         EXIT   (LWRA) = *LWA* OF LAST *WSA*.
*                (LWRB) = MASK FOR LAST *WSA*.
*                (LWRC) = CONTENTS OF *LWA* OF *WSA*.
*
*         USES   X - 2, 3, 5, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 4.
 
 
 CWS      SUBR               ENTRY/EXIT
          SX7    0
          SX5    TCHL        NUMBER OF CHARACTER IN A WORD
          SA3    A1+TPWL     WSA-LENGTH ADDRESS
          SA7    LWRB        VALUE OF MASK MUST BE ZERO
          SA2    A3-B1       WSA-NAME ADDRESS
          SA3    X3          VALUE OF LENGTH
          SX6    X2
          BX7    X3          VALUE OF WSA-LENGTH
          SA6    TPKT+THRL+TPWS  ADDRESS OF WSA INTO PACKET
          PX5    X5          PACK CHARACTERS IN WORD
          SA7    A6+B1       LENGTH OF WSA INTO PACKET
          PX7    X7          PACK WSA-LENGTH
          NX5    X5          NORMALIZE VALUE
          FX7    X7/X5       DIVIDE LENGTH BY 10
          UX7    B4,X7       UNPACK LENGTH IN WORDS
          SX5    TCHL        RESTORE CHARACTERS IN WORD
          LX7    X7,B4       ADJUST LENGTH IN WORDS
          SB4    X7          ADJUST WORD COUNT
          SA2    X6+B4       ADDRESS AND VALUE OF LAST WORD
          IX6    X5*X7       NUMBER OF CHARACTERS IN LAST WORD
          BX7    X2          VALUE OF LAST WORD
          IX5    X3-X6       NUMBER OF CHARACTERS IN LAST WORD
          ZR     X5,CWSX     IF END ON WORD BOUNDRY
          SX6    A2+         ADDRESS OF LAST WORD
          SA7    LWRC        VALUES OF LAST WORD
          SA6    LWRA        ADDRESS OF LAST WORD
          LX7    X5,B1       THE NEXT LINES OF CODE WILL MULTIPLY BY 6
          MX2    1
 
*         THE NEXT LINES OF CODE WILL MULITIPLY THE NUMBER IN
*         X5 BY 6.  THE VALUES IN X5 WILL BE 1 THROUGH 9 WILL
*         RESULT IN VALUSE OF 6 THROUGH 56 RESPECTIVELY.
 
          LX5    X7,B1
          SB4    X5-1
          SB4    B4+X7
          AX7    X2,B4       FORM MASK
          BX7    -X7
          SA7    LWRB        SAVE MASK
          EQ     CWSX        RETURN
 DCF      SPACE  4,15
**        DCF - DBCOMIT AND DBFREE PROCESSOR.
*
*         ENTRY  (B2) - NUMBER FOR PARAMETERS.
*                (X7) - VALUE OF SUBFUNCTION.
*
*         EXIT   FUNCTION PROCESSED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 7.
*                A - 2, 7.
*
*         CALLS  PRT, RTT.
 
 
 DCF      SUBR               ENTRY/EXIT
          RJ     PRT         PRESET
          SX7    0           CLEAR OUT LFN IN PACKET AREA
          SA7    TPKT+THRL+TPSX  CLEARED
          RJ     RQS         ISSUE *TAF/CRM* REQUEST
          SA2    TPKT+THRL+TPSX  TAF-STATUS FROM AAMI
          ZR     X2,DCF1     IF NO ERRORS
          BX1    X2
          RJ     RTT         ISSUE ERROR MESSAGE
 DCF1     SX7    B6-TPDCL    NUMBER OF PARAMETERS
          NG     X7,DCFX     IF NOT ENOUGH PARAMETERS
          SA2    TPKT+THRL+TPSX  TAF-STATUS
          BX7    X2
          SA7    X1          SET TAF-STATUS
          EQ     DCFX        RETURN
 LWR      SPACE  4,15
**        LWR - LAST WORD AND RECORD LENGTH RESTORED.
*
*         ENTRY  (LWRB) = MASK FOR LAST WORD.
*                (LWRA) = ADDRESS OF LAST WORD.
*                (LWRC) = VALUE OF LAST WORD.
*                (TPKT+7) = RECORD LENGTH OF READ.
*                (A1) = POINTER TO PARAMETER LIST.
*
*         (B2) = LENGTH TO PACKET HEADER
*
*         EXIT   RECORD LENGTH AND LAST WORD OF RECORD AREA
*                RESTORED.
*
*         USES   X - 2, 3, 4, 6.
*                A - 2, 3, 4, 6.
*
*         NOTE   (LWRA), (LWRB), AND (LWRC) ARE CONSECUTIVE
*                LOCATIONS.
 
 
 LWR      SUBR               ENTRY/EXIT
          SA3    TPKT+THRL+TPRL  NUMBER OF CHARACTERS FROM PACKET
          SA2    A1+TPRL     RECORD LENGTH
          ZR     X3,LWRX     IF NO RECORD RETURNED
          BX6    X3
          SA6    X2          LENGTH OF RECORD READ
          SA3    LWRA        ADDRESS OF LAST WORD OF RECORD
          SA2    A3+B1       MASK FOR LAST WORD IN RECORD
          SA4    A2+B1       VALUE OF LAST WORD
          SA3    X3+
          ZR     X2,LWRX     IF END ON WORD BOUNDRY
          BX4    X2*X4       LAST WORD
          BX3    -X2*X3      CHARACTERS TO TRANSFER
          BX6    X3+X4       VALUE OF OLD LAST WORD PLUS NEW
          SA6    A3          RESTORE LAST WORD OF RECORD
          EQ     LWRX        RETURN
 
 
 LWRA     BSSZ   1           ADDRESS OF LAST WORD OF WORKING STORAGE
 LWRB     BSSZ   1           MASK OF LAST WORD IN WORD STORAGE
 LWRC     BSSZ   1           VALUE OF LAST WORD IN RECORD
 MST      SPACE  4,15
**        MST -  TO MOVE THE KEY TO PACKET AREA.
*
*         ENTRY  (B2) = CHARACTER POSITION OF GOOD DATA.
*                (B5) = ADDRESS TO RECIEVE TEXT.
*                (A2) = ADDRESS OF DATA STRING TO TRANSFER.
*                (X2) = FIRST WORD OF DATA.
*                (B4) = TOTAL NUMBER OF CHARACTERS TO TRANSFER.
*
*         EXIT   DATA TRANSFERED COMPLETE.
*                (B6) - RESTORED TO NUMBER OF PARAMETERS.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 2, 6.
*                B - 2, 3, 4, 5, 6.
 
 
 MST2     MX1    1
          LX7    X1,B4       SHIFT TO FORM MASK
          LX1    X7,B1
          BX1    X1*X7
          BX6    X1*X6
          SA2    TNPR        NUMBER OF PARAMETERS IN CALL
          SA6    B5
          SB6    X2+         RESTORE NUMBER OF PARAMETERS
 
 MST      SUBR               ENTRY/EXIT
          SB3    B2+B2       CHANGE CHARACTER COUNT TO BIT COUNT
          SB2    B3+B3
          SB2    B2+B3
          SB3    B4+B4       CHANGE NUMBER OF CHARACTERS
          SB4    B3+B3
          SB4    B4+B3
          SB4    -B4         CHANGE TO MINUS BIT COUNT
          SB3    B2-60
          MX1    1
          LX7    X1,B3
          LX1    X7,B1
          BX1    X1*X7
          LX2    B2          POSITION STRING BEGINNING
          BX3    X1*X2
          BX6    X3
          SB6    B3-B2
          LT     B3,B4,MST2  IF LAST WORD
 MST1     SA2    A2+B1
          LX2    B2
          BX6    -X1*X2
          BX6    X3+X6
          BX3    X1*X2
          GE     B4,B6,MST2  IF LAST WORD
          SB4    B4-B6
          SA6    B5          STORE FIRST/NEXT WORD
          SB5    B5+B1
          EQ     MST1        CONTINUE MOVE
 MTS      SPACE  4,15
**        MTS -  TO MOVE TEXT TO STRING.
*
*         ENTRY  (A1) = ADDRESS TO TRANSMIT DATA.
*                (X1) = FIRST DATA TO TRANSMIT.
*                (A2) = ADDRESS TO RECIEVE DATA.
*                (B2) = CHARACTER POSITION.
*                (B4) = NUMBER OF CHARACTERS TO TRANSMIT.
*
*         EXIT   DATA TRANSFERED.
*
*         USES   X - 0, 2, 3, 4, 6, 7.
*                A - 2, 6.
*                B - 2, 3, 4.
 
 
 MTS2     SA2    A6+1        FETCH RESERVED FIELD
 MTS3     SB2    B4-60       REMAINING BITS TO TRANSFER
          MX0    1
          SB2    -B2
          AX7    X0,B2
          LX0    X7,B1
          BX0    X0*X7
          BX6    X0*X6       MERGE NEW RESERVED FIELD
          BX2    -X0*X2
          BX6    X2+X6
          SA6    A2+         SET FIRST/LAST STRING WORD
 
 MTS      SUBR               ENTRY/EXIT
          SB3    B2-B1       CHANGE CHARACTERS TO BITS
          SB3    B3+B3
          SB2    B3+B3
          SB2    B3+B2       STARTING BIT POSITION TO TRANSFER
          SB3    B4+B4       CHANGE CHARACTERS TO BITS
          SB4    B3+B3
          SB4    B3+B4       NUMBER OF BITS TO TRANSFER
          SB4    -B4         NEGATIVE BITS
          SB3    B2-60
          MX0    1
          AX7    X0,B2
          LX0    X7,B1
          BX0    X0*X7
          AX1    B3          POSITION TEXT
          BX4    -X0*X1
          BX3    X0*X1
          SA1    A1+B1       FETCH NEXT WORD OF TEXT
          BX6    X0*X2
          BX6    X4+X6
          SB4    B4-B3
          PL     B4,MTS3     IF MOVE IS COMPLETE
          SA6    A2          STORE FIRST STRING WORD
 MTS1     AX1    B3
          BX4    -X0*X1
          BX6    X3+X4
          BX3    X0*X1
          SB4    B4+60
          PL     B4,MTS2     IF MOVE IS COMPLETED
          SA1    A1+B1
          SA6    A6+B1       STORE NEXT STRING WORD
          EQ     MTS1        CONTINUE MOVE
 PRT      SPACE  4,20
**        PRT -  PRESET PACKET AND HEADER WORDS.
*
*         ENTRY  (A1) = ADDRESS TO PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*                (X7) = SUB-FUNCTION CODE.
*
*         EXIT   (TSA1) = ADDRESS OF PARAMETER LIST.
*                (RQSB) = HEADER WORD  SET FOR *TAF/CRM*.
*                (TPKT) = INITIALIZED TO ZERO.
*                (TPKT+2) = VALUE OF FIRST PARAMETER.
*                (TNPR) = NUMBER OF PARAMETERS.
*                (TFCD) = NAME CURRENT SUB-FUNCTION.
*                (A1) = ADDRESS TO PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*                (B1) = 1.
*                (B6) = NUMBER OF PARAMETERS.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6, 7.
*                B - 1, 6.
 
 
 PRT      SUBR               ENTRY/EXIT
          SA2    PRTA+X7     FUNCTION NAME OF CALLING
          SB1    1
          BX6    X2
          SB6    BUFE-1-TPKT LAST ADDRESS MINUS THE STARTING ADDRESS
          SA6    TFCD        SET FUNCTION CODE NAME
          SX6    0
 PRT1     SA6    TPKT+B6     CLEAR CELLS
          SB6    B6-1
          PL     B6,PRT1     IF NOT LAST CELL
          SX6    A1+
          SA2    X1+         VALUE OF FIRST
          SA6    TSA1        SAVE PARAMETER LIST ADDRESS
          BX6    X2
          SB6    B0
          SA6    TPKT+THRL+TPFN  FIRST PARAMETER VALUE
 PRT2     SA2    A1+B6       NEXT PARAMETER ADDRESS
          ZR     X2,PRT3     IF END OF PARAMETER LIST
          SB6    B6+B1       PARAMETER COUNT
          LT     B6,B2,PRT2  IF NOT MAXIMUM PARAMETERS
 PRT3     SX6    B6          PARAMETER COUNT
          SX2    B6
          LX7    35-11       POSITION SUB-FUNCTION
          LX2    23-5        POSITION COUNT
          SA6    TNPR        SET NUMBER OF PARAMETER PASSED
          BX7    X2+X7       MASK SUB-FUNCTION AND PARAMETER COUNT
          PX7    X7          PUT FUNCTION CODE INTO POSITION
          SA7    RQSB        HEADER WORD (TPKT+1) FOR *TAF/CRM* CALL
          EQ     PRTX        RETURN
 
 PRTA     DATA   C*CLOSE*
          DATA   C*DELETE*
          DATA   C*LOCK*
          DATA   C*FLOCK*
          DATA   C*OPEN*
          DATA   C*READ*
          DATA   C*READL*
          DATA   C*READM*
          DATA   C*READN*
          DATA   C*READNL*
          DATA   C*REWIND*
          DATA   C*REWRITE*
          DATA   C*SKIPBL*
          DATA   C*SKIPFL*
          DATA   C*UNLOCK*
          DATA   C*UNFLOCK*
          DATA   C*WRITE*
          DATA   C*START*
          DATA   C*DBEGIN*
          DATA   C*DBCOMIT*
          DATA   C*DBFREE*
          DATA   C*DBSTAT*
 RTT      SPACE  4,20
 RAD      SPACE  4,20
**        RAD - READ AND READL PROCESSOR.
*
*         ENTRY  (X2) = MAXIMUM PARAMTER COUNT.
*                (X7) = SUB-FUNCION CODE.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 3, 7.
*                A - 1, 2, 3, 7.
*                B - 2, 4.
*
*         CALLS   CWS, CKF, PRT, RQS, RTS, RKA, LWR.
 
 
 RAD      SUBR               ENTRY/EXIT
          RJ     PRT         PRESET
          SX7    B6-TPRDF    REQUIRED NUMBER OF PARAMETERS
          NG     X7,RAD2     IF NOT ENOUGH PARAMETERS
          RJ     CWS         CALCULATE LENGTH OF RECORD
          SX7    B6-TPRK     PARAMETERS REQUIRED FOR KEY-IDENTIFIER
          NG     X7,RAD1     IF END OF PARAMETER LIST
          SA2    A1+TPRO     KEY-IDENTIFIER
          SA2    X2          VALUE OF KEY-IDENTIFIER
          BX7    X2
          SA7    TPKT+THRL+TPRO  KEY-IDENTIFER INTO PACKET
          SX2    B6-TPRLL
          NG     X2,RAD1     IF END OF PARAMETER LIST
          SA3    A1+TPRR     ADDRESS OF KEY-AREA-LENGTH
          SA2    A3-B1       ADDRESS OF KEY-AREA
          SA3    X3          VALUE
          SX7    X2+         ADDRESS OF KEY-AREA
          SA7    TPKT+THRL+TPRK  KEY-AREA ADDRESS TO PACKET
          BX7    X3
          SA7    A7+B1       KEY-AREA-LENGTH INTO PACKET
 RAD1     SB2    TPKA        KEY-AREA
          SB4    0           SET NO MAJOR-KEY-LENGTH
          RJ     CKF         CHECK FIELD LENGTH AND MOVE KEY
          NZ     X7,RAD3     IF KEY-OFFSET ERROR
 RAD2     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 RAD3     RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          SA2    TPKT+THRL+TPCS  *TAF/CRM* STATUS
          NZ     X2,RADX     IF ERROR RETURN
          RJ     LWR         RESTORE LAST WORD AND RECORD LENGTH
          SX2    B6-TPRDF    REQUIRED NUMBER OF PARAMETERS
          NG     X2,RADX     IF LESS THEN REQUIRED
          ZR     X2,RADX     IF END OF LIST
          SA3    TPKT+THRL+TPRDF  KEY-STATUS RESULTS
          SA2    A1+TPRDF    KEY-STATUS ADDRESS
          BX7    X3
          SA7    X2          SET KEY-STATUS
          SX2    B6-TPRDL    PARAMETERS REQUIRED FOR LOCK STATUS
          NG     X2,RAD4     IF END OF PARAMETER LIST
          SA2    TPKT+THRL+TPLB
          SA3    A1+TPLB     LOCK STATUS ADDRESS
          BX7    X2
          SA7    X3          RETURN LOCK STATUS
 RAD4     SX3    B6-TPRLL    PARAMETERS REQUIRED FOR KEY-AREA
          NG     X3,RADX     IF END OF PARAMETER LIST
          SA2    A1+TPRK     KEY-AREA ADDRESS
          RJ     RKA         RETURN KEY-AREA
          EQ     RADX        RETURN
 RDM      SPACE  4,20
**        RDM - READM/READNL/READN PROCESSOR.
*
*         ENTRY  (B2) = MAXIMUM NUMBER OF PARAMETERS.
*                (X0) = NONZERO IF CALLED BY READM FUNCTION.
*                (X7) = SUB-FUNCTION CODE.
*
*         EXIT   FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 4.
*
*         CALLS   CWS, CKF, PRT, RKA, RQS, RTS.
 
 
 RDM      SUBR               ENTRY/EXIT
          RJ     PRT         PRESET
          SX1    B6-TPRL     PARAMETERS REQUIRED FOR *CWS*
          NG     X1,RDM2     IF NOT ENOUGH PARAMETERS
          RJ     CWS         WSA-NAME AND WSA-LENGTH
          SB4    0           SET NO MAJOR-KEY-LENGTH
          SX1    B6-TPRNF    REQUIRED NUMBER OF PARAMETERS
          NG     X1,RDM2     IF NOT ENOUGH PARAMETERS
          SA2    A1+TPKW     KEY-AREA ADDRESS
          SA3    A2+B1       KEY-AREA-LENGTH ADDRESS
          SX7    X2          ADDRESS OF KEY-AREA
          SA3    X3          VALUE OF KEY-AREA-LENGTH
          SX6    X3          VALUE
          SA7    TPKT+THRL+TPKW  KEY-AREA ADDRESS TO PACKET
          SA6    TPKT+THRL+TPLN  VALUE OF KEY-AREA-LENGTH
          ZR     X1,RDM2     IF END OF PARAMETERS
          ZR     X0,RDM2     IF CALLED BY READN OR READNL
          SX1    B6-TPRMF    PARAMETERS REQUIRED FOR READM
          NG     X1,RDM2     IF NOT PARAMETERS FOR READM
          SA2    A1+TPMM     ADDRESS OF MAJOR-KEY-LENGTH
          SA2    X2+         VALUE OF MAJOR-KEY-LENGTH
          SB4    X2
          BX7    X2
          SA7    TPKT+THRL+TPMM  MAJOR-KEY-LENGTH INTO PACKET
          ZR     X1,RDM1     IF END OF PARAMETER LIST
          SX1    B6-TPRDL    PARAMETERS REQUIRED FOR KEY-IDENTIFIER
          NZ     X1,RDM1     IF NO KEY-IDENTIFIER
          SA3    A1+TPMO     ADDRESS OF KEY-IDENTIFIER
          SA3    X3          VALUE
          BX7    X3
          SA7    TPKT+THRL+TPMO  VALUE OF KEY-IDENTIFIER INTO PACKET
 RDM1     SB2    TPYM        INDEX TO PARAMETER LIST FOR KEY-NAME
          RJ     CKF         CHECK AND TRANSFER KEY INTO PACKET
          NZ     X7,RDM3     IF KEY-OFFSET ERRORS
 RDM2     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 RDM3     RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          SX7    B6-TPRNF    REQUIRED NUMBER OF PARAMETERS
          SA2    TPKT+THRL+TPCS  *CRM* STATUS
          NG     X7,RDMX     IF NOT ENOUGH PARAMETERS
          NZ     X2,RDMX     IF ERROR RETURN
          RJ     LWR         LAST WORD OF RECORD AND RECORD LENGTH
          NZ     X0,RDM4     IF NOT CALLED BY READN OR READNL
          ZR     X7,RDM6     IF END OF PARAMETER LIST
          SA3    TPKT+THRL+TPRNF  KEY-STATUS RESULTS
          SA2    A1+TPRNF    ADDRESS OF KEY-STATUS FOR READN OR READNL
          BX7    X3          KEY-STATUS
          SA7    X2          SAVE KEY-STATUS
          SX2    B6-TPRNL
          NG     X2,RDM6     IF END OF PARAMETER LIST
          SA3    TPKT+THRL+TPLA  GET LOCK STATUS
          SA2    A1+TPLA     LOCK STATUS ADDRESS
          EQ     RDM5        PROCESS LOCK STATUS
 
 RDM4     SX7    B6-TPRMF    REQUIRED PARAMETERS FOR READM
          NG     X7,RDMX     IF NOT ENOUGH PARAMETERS
          ZR     X7,RDM6     IF NOT KEY-STATUS
          SA3    TPKT+THRL+TPMS  KEY-STATUS FROM PACKET
          SA2    A1+TPMS     ADDRESS OF KEY-STATUS
          BX7    X3          KEY-STATUS
          SA7    X2          SAVE KEY-STATUS
          SX2    B6-TPRML    PARAMETERS REQUIRED FOR LOCK STATUS
          NG     X2,RDM6     IF END OF PARAMETER LIST
          SA3    TPKT+THRL+TPLC  LOCK STATUS
          SA2    A1+TPLC     GET LOCK STATUS ADDRESS
 RDM5     BX7    X3
          SA7    X2+
 RDM6     SA2    A1+TPKW     KEY-AREA ADDRESS
          RJ     RKA         RETURN KEY-AREA
          EQ     RDMX        RETURN
 RKA      SPACE  4,15
**        RKA - RETURN KEY-AREA.
*
*         ENTRY  (TPKT) = RESULTS OF *TAF/CRM* REQUEST.
*                (A1) = POINTER TO PARAMETER LIST.
*                (A2) = POINTER TO KEY-AREA ADDRESS.
*                (X2) = ADDRESS OF KEY-AREA.
*
*         EXIT   KEY-AREA (PRIMARY KEY) PROCESSED.
*
*         USES   X - 1, 2, 3, 7.
*                A - 1, 2, 3.
*                B - 2, 3, 4, 6.
*
*         CALLS  MTS.
 
 
 RKA      SUBR               ENTRY/EXIT
          SA1    A1+TPWS     WORKING-STORGE-ADDRESS (WSA)
          SB2    X1          ADDRESS OF WSA
          SB3    X2          ADDRESS OF KEY-AREA
          EQ     B2,B3,RKAX  IF SAME ADDRESS RETURN
          SX1    TCHL        LENGTH OF WORD IN CHARACTERS
          SA3    TPKT+THRL+TPRL  RECORD LENGTH FROM PACKET
          SA2    A2+B1       KEY-AREA-LENGTH ADDRESS
          SA2    X2          VALUE
          SX7    X1-1        LENGTH OF WORD MINUS ONE (1)
          SB4    X2+         LENGTH OF KEY-AREA IN CHARACTERS
          GT     B3,B2,RKA1  IF KEY-AREA ADDRESS IS BELOW WSA
 
*         KEY-AREA ADDRESS IS ABOVE WORKING-STORAGE ADDRESS.
 
          IX2    X2+X7       ROUND UP CHARACTERS
          IX2    X2/X1       CHANGE CHARACTERS TO WORDS
          SB6    X2+B3       KEY-AREA ADDRESS PLUS KEY-AREA-LENGTH
          SB6    B6-1        ADJUST FOR INDEX
          LT     B6,B2,RKA2  IF KEY-AREA DOES NOT GO INTO RECORD
          SX1    TCHL        LENGTH OF WORD IN CHARACTERS
          SX3    B2-B3       DIFFERENCE IN KEY-AREA AND WSA
          IX3    X3*X1       NUMBER OF CHARACTERS
          SB4    X3+         ADJUSTED KEY-LENGTH
          EQ     RKA2        GO MOVE PART OF KEY
 
*         KEY-AREA ADDRESS IS BELOW WORKING-STORAGE ADDRESS.
 
 RKA1     IX3    X3+X7       ROUND UP CHARACTERS OF RECORD LENGTH
          IX3    X3/X1       NUMBER OF WORD
          SB6    X3          NUMBER OF WORD MINUS ONE (1)
          SB6    B2+B6       END OF RECORD AREA
          SB6    B6-B1       ADJUST ADDRESS
          LE     B3,B6,RKAX  IF KEY-AREA IS IN RECORD AREA
 
 RKA2     SB2    B1          STARTING POSITION
          SA2    B3          KEY-AREA ADDRESS
          SA1    TKEY        KEY-AREA IN PACKET
          RJ     MTS         TRANSFER KEY TO KEY-AREA
          EQ     RKAX        RETURN
 RTS      SPACE  4,20
**        RTS - RETURN STATUS CODES.
*
*         ENTRY  (TPKT+2) = TAF STATUS RETURNED.
*                (A1) = POINTER TO PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*                (B6) = NUMBER OF PARAMETERS.
*
*         EXIT   *TAF* AND *CRM* STATUS SET IN PROGRAM.
*                (A1) = POINTER TO ADDRESS LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS MESSAGE.
*
*         CALLS  COD, RTT, SNM.
 
 
 RTS      SUBR               ENTRY/EXIT
          SA1    TPKT+THRL+TPTS  VALUE OF TAF-STATUS FROM TAF
          ZR     X1,RTS1     IF NO ERROR
          RJ     RTT         TAF-STATUS CODE
 RTS1     SA1    TPKT+THRL+TPCS  VALUE OF CRM-STATUS FROM AAMI
          ZR     X1,RTS2     IF STATUS OF ZERO
          RJ     COD         CONVERT ERROR CODE TO DISPLAY
          MX3    24          MASK FOR ERROR CODE
          SB2    1RX         REPLACEMENT CHARACTER
          BX1    X3*X4       ERROR CODE
          SB3    RTCB        ASSEMBLY AREA
          SB5    -RTCA       FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          SA1    TFCD        FUNCTION CODE NAME
          SB2    1RY         REPLACEMENT CHARACTER
          SB5    RTCB        FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  RTCB,0,R
 RTS2     SA1    TSA1        RESTORE ADDRESS TO PARAMETER LIST
          SA1    X1+
          LE     B6,B1,RTSX  IF NOT ENOUGH PARAMETERS
          SA3    TPKT+THRL+TPTS  VALUE OF TAF-STATUS FROM AAMI
          SA2    A1+TPTS
          BX6    X3
          SA6    X2          STORE TAF-STATUS
          SX3    B6-TPOPL    PARAMETERS FOR *TAF/CRM* STATUS
          NG     X3,RTSX     IF END OF PARAMETER LIST
          SA2    A1+TPCS     ADDRESS OF CRM-STATUS
          SA3    TPKT+THRL+TPCS  CRM-STATUS FROM AAMI
          BX6    X3
          SA6    X2
          EQ     RTSX        RETURN
 
 RTCA     DATA   C* TAF/CRM CRM STATUS XXXXB IN FUNCTION YYYYYYY.*
 RTCB     BSSZ   *+1-RTCA    ASSEMBLY AREA FOR *SNM*
 RTT      SPACE  4,15
**        RTT - RETURN TAF-STATUS.
*
*         ENTRY  (X1) - TAF-STATUS FORM *TAF/CRM* REQUEST (TPKT).
*                (RTTB) - LOCATION TO PUT MESSAGE ERROR CODE.
*                (RTTC) - LOCATION TO PUT FUNCTION NAME.
*                (TFCD) - NAME OF FUNCTION.
*
*         EXIT - ERROR MESSAGE ISSUED TO DAYFILE.
*                (A1) = ADDRESS OF PARAMETER LIST OF CONSECUTIVE
*                WORDS FOLLOWED BY A WORD OF BINARY ZEROS.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 6.
*
*         MACROS MESSAGE, ABORT.
*
*         CALLS  CDD, SNM.
 
 
 RTT      SUBR               ENTRY/EXIT
          SX5    X1-TTENL    FATAL ERROR STATUS FROM AAMI
          RJ     CDD         CONVERT TO DECIMAL DISPLAY CODE
          MX3    24          MASK FOR ERROR CODE
          SB2    1RX         REPLACEMENT CHARACTER
          BX1    X3*X4       ERROR CODE
          SB3    RTCB        ASSEMBLY AREA
          SB5    -RTTA       FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          SA1    TFCD        FUNCTION CODE NAME
          SB2    1RY         REPLACEMENT CHARACTER
          SB5    RTCB        FWA OF MESSAGE
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  RTCB,0,R
          SA1    TSA1        RESTORE PARAMETER LIST ADDRESS
          SA1    X1+
          NG     X5,RTTX     IF NOT A FATAL ERROR
          ABORT              ABORT DUE TO FATAL *TAF/CRM* ERRORS
 
 RTTA     DATA   C* TAF/CRM TAF STATUS XXXX IN FUNCTION YYYYYYY.*
 RQS      SPACE  4,20
**        RQS - REQUEST *TAF/CRM* SUBSYSTEM.
*
*         ENTRY  (RQSA) = HEADER WORD ONE.
*                (RQSB) = HEADER WORD TWO.
*                (TPKT) = FUNCTION PARAMETERS.
*
*         EXIT   (TPKT) = RESULTS FROM *TAF/CRM*.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 4.
*
*         MACROS CALLSS, ABORT, MESSAGE, RECALL.
 
 
 RQS      SUBR               ENTRY/EXIT
 RQS1     SA1    RQSA        FIRST WORD OF HEADER
          SA2    RQSB        SECOND HEADER WORD FOR *TAF/CRM*
          BX7    X1
          BX6    X2
          SA7    TPKT        FIRST WORD OF PACKET AREA
          SA6    A7+B1       *UPC* INTERFACE WORD
          CALLSS /SSD/TRSI,TPKT,R  *UCP* CALL TO TAF VIA MONITOR
 RQS2     SA1    A7          CHECK FOR RESPONSE
          LX1    59-0        RESPONSE IN BIT (0)
          NG     X1,RQS3     IF CALL TO *TAF/CRM* COMPLETE
          RECALL
          EQ     RQS2        IF COMPLETE NOT SET
 
 RQS3     SX2    7776B       MASK FOR ERRORS
          LX1    0-0-59+0    SHIFT RESPONSE
          SB4    B0          TABLE INCREMENT COUNT TO ZERO
          BX2    X1*X2
          ZR     X2,RQS5     IF NO ERRORS
 RQS4     SA1    RQSS+B4     SUBSYSTEM ERROR CODES
          SX7    X1
          IX7    X2-X7       SUBTRACT CODES
          SB4    B4+1        INCREMENT TABLE INDEX
          ZR     X7,RQS7     IF MATCH OF ERROR CODES
          ZR     X1,RQS11    IF END OF TABLE
          EQ     RQS4        LOOK AT NEXT
 
 RQS5     SA1    TPKT+1      LOOK AT SECOND WORD OF HEADER FOR ERRORS
          MX2    -12         MASK FOR ERROR CODES
          BX2    -X2*X1      MASK OFF RESPONSE
          ZR     X2,RQS1     IF NO RESPONSE
 RQS6     SA1    RQST+B4     LOOK AT ALL ERROR CODES
          SX7    X1
          IX7    X7-X2       SUBTRACT OFF ERROR CODES
          SB4    B4+1        INCREMENT TABLE INDEX
          ZR     X7,RQS7     IF MATCH OF ERROR CODES
          ZR     X2,RQS11    IF NO MATCH OF ERROR CODES
          EQ     RQS6        GET NEXT ERROR CODE
 
 RQS7     LX1    17-59       SHIFT ADDRESS OF MESSAGE
          SX2    X1          ADDRESS OF MESSAGE
          LX1    17-41-17+59 ADDRESS OF ROUTINE
          SB4    X1
          ZR     X2,RQS8     IF NOT ERROR MESSAGE
          MX7    -6          MASK FOR DISPLAY DAYFILE
          LX1    5-23-17+41  SHIFT DISPLAY MESSAGE AREA
          BX7    -X7*X1      MASK OFF DISPLAY VALUE
          MESSAGE  X2,X7,R   ISSUE ERROR MESSAGE
 RQS8     SA1    TSA1        RESTORE TO PARAMETER LIST ADDRESS
          SA1    X1+
          JP     B4          GO TO ROUTINE FOR PROCESSING
 
 RQS9     SA1    0           LOCATION ZERO OF *CP* RA+0
          SX7    1
          LX7    12-0        SHIFT *PAUSE* BIT
          BX7    X1+X7
          SA7    0           SET IN RA+0
 RQS10    RECALL             RECALL BEFOR RETRY
          SA1    B0          RA+0
          LX1    59-12       SHIFT TO POSITION FOR TEST
          NG     X1,RQS10    IF *PAUSE* BIT NOT CLEARED
          EQ     RQS1        *GO* ENTERED REISSUE REQUEST
 
 RQS11    MESSAGE  RQML,0,R  TAF ERROR NOT DEFINED
 RQS12    ABORT              TERMINATE PROCESSING
 
 
 RQSA     VFD    24/0LTAF,12/0,6/40,4/0,2/3,11/0,1/0
 RQSB     BSSZ   1           SECOND WORD OF HEADER
 
 
*         ERROR MESSAGES FOR *RQS*  FROM *TAF/CRM*.
 
 
 RQST     EQU    *                  SECOND HEADER WORD ERROR CODE
          FCTM   ,RQSX,,JSRC        REQUEST COMPLETE
          FCTM   RQMA,RQS9,0,JSNU   *TAF* SUBSYSTEM NOT UP
          FCTM   RQMB,RQS1,1,JSTB   *TAF* SUBSYSTEM BUSY
          FCTM   RQMJ,RQS12,0,JSND  SUBSYSTEM NOT DEFINED AS *SCP*
          FCTM   RQMI,RQS9,0,JSTI   *TAF* DEFINED - *TAF* IDLE
          FCTM   RQMD,RQS12,0,JSNV  USER NOT VALID FOR *TAF* ACCESS
          FCTM   RQME,RQS12,0,JSUA  USER NAME ACTIVE
          FCTM   RQMK,RQS12,0,JSAT  CONFLICT IN ACCESS TYPE
          FCTM   RQMG,RQS12,0,JSFL  DATA NOT WITHIN *UCP* FL
          FCTM   RQMF,RQS12,0,JSOR  TWO OUTSTANDING REQUEST
          FCTM   RQMC,RQS12,0,JSFC  *TAF* FUNCTION CODE NOT VALID
          FCTM   RQMM,RQS12,0,JSRE  RECOVERY REQUEST ERROR
          FCTM   RQMN,RQS12,0,JSDC  BATCH CONCURRENCY DISABLED
          FCTM   RQMO,RQS12,0,JSNC  TAF/CRM DATA MANAGER NOT IN TAF
          CON    0                  END OF LIST
 
 
 RQSS     EQU    *                      FIRST HEADER WORD ERROR CODES
          FCTM   RQMA,RQS9,0,/SCP/ES1   SUBSYSTEM NOT PRESENT
          FCTM   RQMB,RQS1,1,/SCP/ES2   SUBSYSTEM BUSY
          FCTM   RQMJ,RQS12,0,/SCP/ES3  SSID INCORRECT
          CON    0                      END OF LIST
 
 
 RQMA     DATA   C* TAF NOT PRESENT (GO OR DROP).*
 
 RQMB     DATA   C* TAF SUBSYSTEM BUSY. *
 
 RQMC     DATA   C* TAF FUNCTION CODE NOT VALID.*
 
 RQMD     DATA   C* TAF USER NOT VALID FOR TAF ACCESS.*
 
 RQME     DATA   C* TAF USER NAME ACTIVE.*
 
 RQMF     DATA   C* TAF TWO OUTSTANDING REQUESTS.*
 
 RQMG     DATA   C* TAF DATA NOT WITHIN UCP FL.*
 
 RQMI     DATA   C* TAF IDLE (GO OR DROP).*
 
 RQMJ     DATA   C* TAF SUBSYSTEM NOT DEFINED AS A SCP.*
 
 RQMK     DATA   C* TAF USER CONFLICT IN ACCESS TYPE.*
 
 RQML     DATA   C* TAF ERROR CODE NOT DEFINED.*
 
 RQMM     DATA   C* TAF RECOVERY REQUEST ERROR.*
 
 RQMN     DATA   C* BATCH CONCURRENCY DISABLED.*
 
 RQMO     DATA   C* TAF/CRM DATA MANAGER NOT LOADED IN TAF.*
 SKP      SPACE  4,15
**        SKP - SKIP FUNCTION PROCESSOR.
*
*         ENTRY  (B2) = NUMBER OF PARAMETERS.
*                (X7) = SUB-FUNCTION CODE.
*
*         EXIT   FUNCTION COMPETED AND STATUS RETURNED.
*
*         USES   X - 2, 7.
*                A - 2, 7.
*                B - 2.
*
*         CALLS  PRT, RQS, RTS.
 
 
 SKP      SUBR               ENTRY/EXIT
          RJ     PRT         PRESET
          SB2    TPSBL       NUMBER OF PARAMETERS
          LT     B6,B2,SKP1  IF NOT ENOUGH PARAMETERS
          SA2    A1+TPCT     COUNT ADDRESS
          SA2    X2          VALUE OF COUNT
          BX7    X2
          SA7    TPKT+THRL+TPCT  PUT COUNT IN PACKET
 SKP1     RJ     RQS         ISSUE *TAF/CRM* REQUEST
          RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          EQ     SKPX        RETURN
 WRR      SPACE  4,15
**        WRR - WRITE AND REWRITE A RECORD.
*
*         ENTRY  (B2) - MAXIMUM NUMBER OF PARAMETERS.
*                (X7) - FUNCTION CODE.
*
*         EXIT FUNCTION COMPLETED AND STATUS RETURNED.
*
*         USES   X - 1, 2, 3, 7.
*                A - 1, 2, 3, 7.
*                B - 2, 4.
*
*         CALLS  CKF, MTS, PRT, RQS, RTS.
 
 
 
 WRR      SUBR               ENTRY/EXIT
          RJ     PRT         PRESET
          SB2    TPWRF       PARAMETERS NEEDED
          LT     B6,B2,WRR2  IF NOT ENOUGH PARAMETERS
          SA3    A1+TPWR     ADDRESS OF RECORD LENGTH
          SA2    A1+TPWS     ADDRESS OF WSA-NAME
          SX7    X2
          SA3    X3          VALUE OF RECORD LENGTH
          SA7    TPKT+THRL+TPWS  STORE ADDRESS INTO PACKET
          BX7    X3
          SB4    TPWRL       NUMBER OF PARAMETERS NEEDED FOR KEY-AREA
          SA7    TPKT+THRL+TPWR  RECORD LENGTH INTO PACKET
          EQ     B6,B2,WRR1  IF END OF PARAMETER LIST
          LT     B6,B4,WRR1  IF NO KEY-AREA AND KEY-AREA-LENGTH
          SA3    A1+TPWY     ADDRESS OF KEY-AREA-LENGTH
          SA2    A1+TPWX     ADDRESS OF KEY-AREA
          SX7    X2          ADDRESS OF KEY-AREA
          SA3    X3          VALUE OF KEY-AREA-LENGTH
          SA7    TPKT+THRL+TPWX  KEY-AREA ADDRESS INTO PACKET
          BX7    X3
          SA7    TPKT+THRL+TPWY  KEY-AREA-LENGTH INTO PACKET
 WRR1     SB2    TPWK        PARAMETER POSITION OF KEY-AREA
          SB4    0           SET NO MAJOR KEY
          RJ     CKF         CHECK AND TRANSFER KEY INTO PACKET
          NZ     X7,WRR3     IF KEY-POSITION ERRORS
 WRR2     RJ     RQS         ISSUE *TAF/CRM* REQUEST
 WRR3     RJ     RTS         TAF-STATUS AND CRM-STATUS RETURNED
          SA2    TPKT+THRL+TPCS  *TAF/CRM* STATUS
          NZ     X2,WRRX     IF ERROR
          SB2    TPRWL       MINIMUM NUMBER OF PARAMETERS
          LE     B6,B2,WRRX  IF NO KEY-AREA AND KEY-AREA-LENGTH
          SA3    A1+TPWY     ADDRESS OF KEY-AREA-LENGTH
          SA2    A1+TPWX     ADDRESS OF KEY-AREA
          SA3    X3          VALUE OF KEY-AREA-LENGTH
          SB2    B1          KEY-POSITION
          SA2    X2          ADDRESS OF KEY-AREA
          SB4    X3          NUMBERS OF CHARACTERS TO MOVE
          SA1    TKEY        ADDRESS OF KEY IN PACKET
          RJ     MTS         MOVE KEY TO KEY-AREA
          EQ     WRRX        RETURN
 COMMON   SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCSYS
*CALL     COMCCDD
*CALL     COMCCOD
*CALL     COMCSNM
 COMMON   SPACE  4,65
**        COMMON WORK STORAGE.
*
*T   W+0  24/ RSS,  12/ RIN, 6/ WC, 4/ RCD, 2/ R, 11/ ES, 1/ C
*
*         RSS = RESERVED FOR *TAF* USE; = THE CHARACTERS "TAF".
*         RIN = RESERVED FOR INSTALLATION.
*         WC  = WORD COUNT (COUNT-1) OF REQUEST PACKET.
*         RCD = RESERVED FOR OPERATING SYSTEM.
*         R   = RETURN CODE.
*         ES  = ERROR STATUS.
*         C   = COMPLETE BIT, SET TO ZERO (0) BY OBJECT-TIME
*               PRIOR TO FUNCTION OR MACRO CALL.
*
*T,  W+1  6/ FC, 18/ ADDR, 6/ AC, 30/ 0
*
*         FC   = *TAF/CRM* FUNCTION CODE
*         ADDR =  ADDRESS WITHIN THE CALLING OBJECT-TIME, WHERE
*                *TAF* IS TO WRITE THE RESPONSE PACKET.
*         AC   = PARAMETER COUNT (NUMBER OF PARAMETER PASSED).
*
*    W+2  6O/  FILE NAME OR UBEGIN-ID FOR REQUEST
*              TAF-STATUS FOR DBCOMIT/DBSTAT/DBFREE REQUEST
*
*
*    W+3  60/  TAF-STATUS
*
*    W+4  60/  KEY-NAME FOR SKIP REQUEST OR CRM-STATUS
*
*    W+5  60/  COUNT FOR SKIP REQUEST  OR
*              KEY-NAME FOR DELETE REQUEST OR
*              KEY-OFFSET FOR LOCK REQUEST OR
*              WSA-NAME
*
*    W+6  60/  KEY-OFFSET FOR DELETE REQUEST OR
*              RECORD LENGTH FOR WRITE REQUEST OR
*              WSA-LENGTH
*
*    W+7  60/  KEY-NAME FOR WRITE REQUEST OR
*              RECORD LENGTH
*
*    W+10 60/  KEY-AREA FOR READM/READN/READNL REQUEST  OR
*              KEY-NAME
*
*    W+11 60/  KEY-AREA-LENGTH FOR READM REQUEST OR
*              KEY-AREA-LENGTH FOR READN REQUEST OR
*              KEY-AREA-LENGTH FOR READNL REQUEST OR
*              KEY-OFFSET
*
*    W+12 60/  KEY-NAME FOR READM REQUEST
*              MAJOR-KEY-LENGTH FOR START
*              KEY-AREA-LENGTH FOR WRITE
*              KEY-STATUS
*
*    W+13 60/  KEY-OFFSET FOR READM REQUEST OR
*              KEY-IDENTIFIER FOR READ/READL REQUEST OR
*              LOCK STATUS FOR READN
*
*    W+14 60/  MAJOR-KEY-LENGTH FOR READM REQUEST OR
*              KEY-AREA FOR READ/READL REQUEST
*
*    W+15 60/  KEY-STATUS FOR READM REQUEST OR
*              KEY-AREA-LENGTH FOR READ/READL REQUEST
*
*    W+16 60/  KEY-IDENTIFIER FOR READM REQUEST OR
*              LOCK STATUS FOR READ
*
*    W+17 60/  LOCK STATUS FOR READM
*
*    W+20 60/  KEY
*
*
*
*
*    W+52
 
          USE    BUFFERS
 
 
 BUFA     BSS    0           STARTING ADDRESS OF LITERAL AREA
 BEGIN    BSSN   BUFA        START OF BUFFER AREA
 TNPR     BSSN   1           MAXIMUM NUMBER OF PARAMETER FOR FUNCTION
 TFCD     BSSN   1           NAME OF CALLING FUNCTION
 TSA1     BSSN   1           PARAMETER LIST ADDRESS
 TPKT     BSSN   43          PACKET TO AND FROM *TAF/CRM*
 TKST     EQU    TPKT+THRL+TPSF  KEY STATUS FOR PACKET AREA
 TKEY     EQU    TPKT+16     KEY AREA OF REQUEST PACKET
 BUFE     BSSN   0           END OF BUFFER AREA
 END      BSSN
          ORG    BUFE
 
 
          END