ASMB,Q,C
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER :  92067-18366 
* 
*     RELOCATABLE PART NUMBER : 92067-16362 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
* 
*     ACOPN - ROUTINE TO OPEN THE ACCOUNT FILE
* 
*     CALLING SEQUENCE:  CALL ACOPN(IERR) 
*                WHERE
*                        IERR = ACERR RETURN WORD 
* 
*     ACERRS:            FMP ACERR (OPEN) 
* 
* 
      NAM ACOPN,7 92067-16362 REV.2001 791018 
      ENT ACOPN 
      EXT $SMID,OVRD.,.ENTR,ACOM1,OPEN,ISMVE
      EXT $ACFL,$LIBR,$LIBX,ACOMD,LOCF
* 
A     EQU 0 
* 
IERR  NOP 
IDSES NOP 
* 
ACOPN NOP 
      JSB .ENTR     GET PARAMETERS
      DEF IERR
* 
      LDA 1717B     GET SESSION WORD IN ID SEG
      ADA D32 
      XLA A,I 
      STA SESWD 
* 
      CMA,INA       IF SESWD IS <= 0 THEN NON-SESSION 
      SSA,RSS 
      JMP RTRN1     SO DONT CALL ISMVE
* 
      JSB ISMVE     GET SESSION ID
      DEF RTRN1 
      DEF SESWD 
      DEF $SMID 
      DEF IDSES,I 
      DEF D1
* 
RTRN1 LDA OVRD.     SET OVERIDE BIT FOR OPEN
      IOR SIGN
      STA OVRD. 
* 
      XLA $ACFL+0   GET DISC LU FOR ACCOUNTS FILE 
      STA ACOMD+8 
* 
      JSB OPEN      OPEN +@CCT!:-31178
      DEF RTRN2 
      DEF ACOM1     DCB 
      DEF IERR,I    ERROR CODE RETURN 
      DEF FNAME     FILE NAME 
      DEF D1        FILE TYPE 
      DEF SC        SECURITY CODE 
      DEF ACOMD+8        DISC LU  
      DEF D256      DCB SIZE
* 
RTRN2 LDA OVRD.     CLEAR OVERIDE BIT 
      AND B7... 
      STA OVRD. 
* 
      LDA $ACFL     IF DICSC LU SET UP RETURN 
      SZA 
      JMP ACOPN,I 
* 
      JSB LOCF      ELSE FIND LU OF ACCOUNTS FILE 
      DEF RTRN3     WITH LOCF CALL
      DEF ACOM1     DCB OF FILE 
      DEF IDUM
      DEF IDUM      SPACING TO DISC LU
      DEF IDUM
      DEF IDUM
      DEF IDUM
      DEF ACOMD+8        DISC LU IS RETURNED HERE 
* 
RTRN3 LDA ACOMD+8        PUT -LU IN $ACFL 
      SSA,RSS       MAKE SURE IT IS NEGATIVE
      CMA,INA 
      JSB $LIBR       MUST GO PRIVILEGED
      NOP 
      XSA $ACFL+0 
      JSB $LIBX 
      DEF ACOPN     AND RETURN
* 
* 
D1    DEC 1 
D32   DEC 32
D256  DEC 256 
SC    DEC -31178
IDUM  BSS 1 
SIGN  OCT 100000
B7... OCT 77777 
* 
FNAME ASC 3,+@CCT!
* 
SESWD BSS 1 
* 
      END 
                                                                                                  