AFSLCK1.m

AFSLCK1 ; IHS/OIRM/DSD/JDM-OPEN HFS/FILES;     [ 10/27/2004   4:21 PM ]

 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;

 ;;MODIFIED FOR CACHE' COMPLIANCE ACR*2.1*9 IM13574

 Q  ;NOT AN ENTRY POINT

PADWRITE ; ENTRY POINT.

 U %DEV W X,!

 Q

OHFSDOC ;;VARIABLES REQUIRED FOR OPENHFS CALL

 ;;

 ;;   %DEV      -- INITIALLY SET TO 51

 ;;   %FN       -- UNIX FILE NAME (FULL PATH IF NEC)

 ;;   AFSERMSG  -- CONTAINS ERROR MESSAGE (VARIABLE OUT)

 ;;   Y         -- CONTAINS COMPLETION CODE( >0 = ERROR) (VARIABLE OUT)

 ;;   %IN       -- OPEN PARAMETER (1=READ ONLY) DEFAULT VALUE

 ;;   %FO       --  FILE OFFSET (DEFAULT = 0)

OPENHFS ;EP

 ;I '$D(%DEV) S %DEV=51                      ;ACR*2.1*13.01 IM13574

 ;I '$D(%IN) S %IN=1                         ;ACR*2.1*13.01 IM13574

 ;I '$D(%FO) S %FO=0                         ;ACR*2.1*13.01 IM13574

 ;S N=$L(%FN,"/")                            ;ACR*2.1*13.06 IM14144

 ;S ZISH1=$P(%FN,"/",1,N-1)_"/"              ;ACR*2.1*13.06 IM14144

 ;S ZISH2=$P(%FN,"/",N)                      ;ACR*2.1*13.06 IM14144

 ;S ZISH3=$S(%IN=1:"R",%IN=0:"W",1:"R")      ;ACR*2.1*13.01 IM13574

 ;S ZISH4="R"                                ;ACR*2.1*13.01 IM13574

 ;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)     ;ACR*2.1*13.01 IM13574

 ;I Y'=0 S AFSERMSG="M10"                    ;ACR*2.1*13.01 IM13574

 ;E  S %DEV=IO                               ;ACR*2.1*13.01 IM13574

 N AFSLDEL,AFSLN                             ;ACR*2.1*13.01 IM13574

 S AFSLDEL=$E(%FN)                           ;ACR*2.1*13.01 IM13574

 S AFSLN=$L(%FN,AFSLDEL)                     ;ACR*2.1*13.01 IM13574

 S ZISH1=$P(%FN,AFSLDEL,1,AFSLN-1)_AFSLDEL   ;ACR*2.1*13.01 IM13574

 S ZISH2=$P(%FN,AFSLDEL,AFSLN)               ;ACR*2.1*13.01 IM13574

 S ZISH3=$S($G(%IN)=0:"W",1:"R")             ;ACR*2.1*13.01 IM13574

 D HFS^ACRFUTL(ZISH1,ZISH2,ZISH3,.%DEV)      ;ACR*2.1*13.01 IM13574

 I $G(%DEV)']"" S AFSERMSG="M10"             ;ACR*2.1*13.01 IM13574

 Q

ERROR ;EP

 G ERROREX:'$D(AFSERMSG)

 S X=$P($T(@AFSERMSG),";;",2)

ERROREX S AFSJFLG=1 K AFSERMSG Q

BTRMDEF ;EP

 W !!!,"PROPER TERMINAL ATTRIBUTES MISSING  -  NOTIFY SITE MANAGER",!! H 3 Q

 ;

CLOSE ;EP;TO CLOSE %ZISH OPENED DEVICE *** ACR*2.1*13.01 IM13574

 D CLOSE^%ZISH()

 K IOP,IOPAR,%ZIS,ZTSK,ZTQUEUED,ZTREQ

 Q

M1 ;;COMPUTER CENTER FOR TELECOMMUNICATIONS NOT CORRECTLY DEFINED

M2 ;;IHS COMM PARAMETERS NOT SET FOR THIS LOCATION

M3 ;;3780 TELECOMMUNICATIONS PORT NOT DEFINED

M4 ;;REMOTE NUMBER NOT DEFINED FOR THIS COMPUTER CENTER"

M5 ;;USER ID OR USER PASSWORD NOT DEFINED

M6 ;;DEFAULT 3780 COMMUNICATION PORT IN USE

M7 ;;ALL 3780 COMMUNICATION PORTS ARE BUSY

M8 ;;ALL UNIX HFS DEVICES ARE BUSY

M9 ;;PROGRAM AND/OR FUNCTION CANCELLED BY OPERATOR

M10 ;;OPEN FAILURE ON UNIX HFS FILE

M11 ;;DEFAULT PRINTER PORT NOT CORRECTLY DEFINED

M12 ;;PRINTER SET-UP ERROR -- NOTIFY SUPERVISOR

M13 ;;EXPORT AND/OR APPLICATION PARAMETERS NOT SET CORRECTLY

M14 ;;PACKAGE PREFIX NOT FOUND

AFSLCK1   ; IHS/OIRM/DSD/JDM-OPEN HFS/FILES;     [ 10/27/2004   4:21 PM ]

 +1       ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;

 +2       ;;MODIFIED FOR CACHE' COMPLIANCE ACR*2.1*9 IM13574

 +3       ;NOT AN ENTRY POINT

           QUIT 

PADWRITE  ; ENTRY POINT.

 +1        USE %DEV

           WRITE X,!

 +2        QUIT 

OHFSDOC   ;;VARIABLES REQUIRED FOR OPENHFS CALL

 +1       ;;

 +2       ;;   %DEV      -- INITIALLY SET TO 51

 +3       ;;   %FN       -- UNIX FILE NAME (FULL PATH IF NEC)

 +4       ;;   AFSERMSG  -- CONTAINS ERROR MESSAGE (VARIABLE OUT)

 +5       ;;   Y         -- CONTAINS COMPLETION CODE( >0 = ERROR) (VARIABLE OUT)

 +6       ;;   %IN       -- OPEN PARAMETER (1=READ ONLY) DEFAULT VALUE

 +7       ;;   %FO       --  FILE OFFSET (DEFAULT = 0)

OPENHFS   ;EP

 +1       ;I '$D(%DEV) S %DEV=51                      ;ACR*2.1*13.01 IM13574

 +2       ;I '$D(%IN) S %IN=1                         ;ACR*2.1*13.01 IM13574

 +3       ;I '$D(%FO) S %FO=0                         ;ACR*2.1*13.01 IM13574

 +4       ;S N=$L(%FN,"/")                            ;ACR*2.1*13.06 IM14144

 +5       ;S ZISH1=$P(%FN,"/",1,N-1)_"/"              ;ACR*2.1*13.06 IM14144

 +6       ;S ZISH2=$P(%FN,"/",N)                      ;ACR*2.1*13.06 IM14144

 +7       ;S ZISH3=$S(%IN=1:"R",%IN=0:"W",1:"R")      ;ACR*2.1*13.01 IM13574

 +8       ;S ZISH4="R"                                ;ACR*2.1*13.01 IM13574

 +9       ;S Y=$$OPEN^ZISHMSMU(ZISH1,ZISH2,ZISH3)     ;ACR*2.1*13.01 IM13574

 +10      ;I Y'=0 S AFSERMSG="M10"                    ;ACR*2.1*13.01 IM13574

 +11      ;E  S %DEV=IO                               ;ACR*2.1*13.01 IM13574

 +12      ;ACR*2.1*13.01 IM13574

           NEW AFSLDEL,AFSLN

 +13      ;ACR*2.1*13.01 IM13574

           SET AFSLDEL=$EXTRACT(%FN)

 +14      ;ACR*2.1*13.01 IM13574

           SET AFSLN=$LENGTH(%FN,AFSLDEL)

 +15      ;ACR*2.1*13.01 IM13574

           SET ZISH1=$PIECE(%FN,AFSLDEL,1,AFSLN-1)_AFSLDEL

 +16      ;ACR*2.1*13.01 IM13574

           SET ZISH2=$PIECE(%FN,AFSLDEL,AFSLN)

 +17      ;ACR*2.1*13.01 IM13574

           SET ZISH3=$SELECT($GET(%IN)=0:"W",1:"R")

 +18      ;ACR*2.1*13.01 IM13574

           DO HFS^ACRFUTL(ZISH1,ZISH2,ZISH3,.%DEV)

 +19      ;ACR*2.1*13.01 IM13574

           IF $GET(%DEV)']""

               SET AFSERMSG="M10"

 +20       QUIT 

ERROR     ;EP

 +1        IF '$DATA(AFSERMSG)

               GOTO ERROREX

 +2        SET X=$PIECE($TEXT(@AFSERMSG),";;",2)

ERROREX    SET AFSJFLG=1

           KILL AFSERMSG

           QUIT 

BTRMDEF   ;EP

 +1        WRITE !!!,"PROPER TERMINAL ATTRIBUTES MISSING  -  NOTIFY SITE MANAGER",!!

           HANG 3

           QUIT 

 +2       ;

CLOSE     ;EP;TO CLOSE %ZISH OPENED DEVICE *** ACR*2.1*13.01 IM13574

 +1        DO CLOSE^%ZISH()

 +2        KILL IOP,IOPAR,%ZIS,ZTSK,ZTQUEUED,ZTREQ

 +3        QUIT 

M1        ;;COMPUTER CENTER FOR TELECOMMUNICATIONS NOT CORRECTLY DEFINED

M2        ;;IHS COMM PARAMETERS NOT SET FOR THIS LOCATION

M3        ;;3780 TELECOMMUNICATIONS PORT NOT DEFINED

M4        ;;REMOTE NUMBER NOT DEFINED FOR THIS COMPUTER CENTER"

M5        ;;USER ID OR USER PASSWORD NOT DEFINED

M6        ;;DEFAULT 3780 COMMUNICATION PORT IN USE

M7        ;;ALL 3780 COMMUNICATION PORTS ARE BUSY

M8        ;;ALL UNIX HFS DEVICES ARE BUSY

M9        ;;PROGRAM AND/OR FUNCTION CANCELLED BY OPERATOR

M10       ;;OPEN FAILURE ON UNIX HFS FILE

M11       ;;DEFAULT PRINTER PORT NOT CORRECTLY DEFINED

M12       ;;PRINTER SET-UP ERROR -- NOTIFY SUPERVISOR

M13       ;;EXPORT AND/OR APPLICATION PARAMETERS NOT SET CORRECTLY

M14       ;;PACKAGE PREFIX NOT FOUND