AFSTCK1.m

AFSTCK1 ; IHS/OIRM/ADC/CSC-PART 2 OF GENERIC TELECOMMUNICATION VARIABLE CHECK PROGRAM;     [ 10/27/2004  4:22 PM ]

 ;;2.0;IHS 3780 TELECOMMUNICATIONS;**13**;AUG 9, 1995

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

 Q  ;NOT AN ENTRY POINT

PADWRITE ; ENTRY POINT.

 U %DEV W X,!

 Q

CCTRID ;EP

 S AFSUXFNM=$S(AFSCCTR="DPS":"ddps",AFSCCTR="NIH":"nih",AFSCCTR="BCS":"bcbs",AFSCCTR="PCC":"pcc",1:" ")

 S AFSCCTRN=$S(AFSCCTR="DPS":"IHS Data Center (ALBQ)",AFSCCTR="NIH":"National Inst. of Hlth (Bethesda)",AFSCCTR="BCS":"Blue Cross / Shield (NM)",AFSCCTR="PCC":"Parklawn Computer Center (PCC)",1:"Z")

 Q

CCTRIDR ;EP

 I AFSCCTR'="PCC" S AFSRRTYP=$S(AFSCCTR="BCS":"B",AFSCCTR="NIH":"N",AFSCCTR="DPS":"I",1:"X"),Y=AFSRRTYP

 ;S AFSRRTYP=AFSRTYPE

 Q

OHFSDOC ;;VARIABLES REQUIRED FOR OPENHFS CALL

 ;;

 ;;   %DEV      -- INITIALLY SET TO 51

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

 ;;   AFSERMSG  -- CONTAINS ERROR MESSAGE

 ;;   %ZA       -- CONTAINS COMPLETION CODE (-1 = ERROR)

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

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

OPENHFS ;PEP; OPEN FILE IN DIRECTORY

 I '$D(%IN) S %IN=1

 I '$D(%FO) S %FO=0

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

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

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

 N ACRDIR,ACRDEL                          ;ACR*2.1*13.06 IM14144

 S ACRDIR=$$ARMSDIR^ACRFSYS(1)            ;ACR*2.1*13.06 IM14144

 I ACRDIR']"" S AFSERMSG="M15" Q          ;ACR*2.1*13.06 IM14144

 S ACRDEL=$E(ACRDIR)                      ;ACR*2.1*13.06 IM14144

 S ZISH1=$P(%FN,ACRDEL,1,4)_ACRDEL ;CSC 7-95 ;ACR*2.1*13.01 IM13574

 S ZISH2=$P(%FN,ACRDEL,5)                 ;ACR*2.1*13.06 IM14144

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

 S Y=$$OPEN^%ZISH(ZISH1,ZISH2,ZISH3)

 ;I %ZA=-1 S AFSERMSG="M10"

 I Y'=0 S AFSERMSG="M10"

 E  S %DEV=IO

 Q

ERROR ;PEP; WRITES VARIABLE ERROR MESSAGES

 G ERROREX:'$D(AFSERMSG)

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

 U IO(0) W !!,*7,?(80-$L(X)/2),X,!

 K DIR S DIR(0)="E",DIR("A")="Enter <RETURN> to Continue" D ^DIR

ERROREX S AFSJFLG=1 K AFSERMSG Q

CRTSETUP ;PEP; SETS UP VARIABLES FOR CRT

 I '$G(IOST(0)) D HOME^%ZIS ;pdw

 S XY=$P(^%ZIS(2,IOST(0),1),"^",5)

 I '$D(^%ZIS(1,IOS,"SUBTYPE")) G BTRMDEF

 I '$D(^%ZIS(1,IOS,"TYPE")) G BTRMDEF

 I ^%ZIS(1,IOS,"TYPE")'="TRM"&(^%ZIS(1,IOS,"TYPE")'="VTRM") G BTRMDEF

 I '$D(^%ZIS(2,IOST(0),5)) G BTRMDEF

 S AFSLE=$P(^%ZIS(2,IOST(0),5),"^",6)

 S AFSLE="W "_AFSLE

 S AFSRVON=$P(^%ZIS(2,IOST(0),5),"^",4)

 S AFSRVOF=$P(^%ZIS(2,IOST(0),5),"^",5)

 S X=0 X ^%ZOSF("RM")

 Q

UXFILKIL ;EP

 S AFSCMD="rm /usr/bin/3780/RCVFILE*"

 S AFSTCMDR=AFSCMD D HOSTCMD^AFSTCKZC K AFSTCMDR ;CSC 7-95

 S AFSCMD="rm /usr/ihs/reports/ddpsnull*"

 S AFSTCMDR=AFSCMD D HOSTCMD^AFSTCKZC K AFSTCMDR ;CSC 7-95

 Q

BTRMDEF ;EP

 W !!!,"PROPER TERMINAL ATTRIBUTES MISSING  -  NOTIFY SITE MANAGER",!! H 3 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

M15 ;;DIRECTORY PATH NOT DEFINED IN FMS SYSTEM DEFAULTS FILE ;;ACR*2.1*13.06 IM14144

AFSTCK1   ; IHS/OIRM/ADC/CSC-PART 2 OF GENERIC TELECOMMUNICATION VARIABLE CHECK PROGRAM;     [ 10/27/2004  4:22 PM ]

 +1       ;;2.0;IHS 3780 TELECOMMUNICATIONS;**13**;AUG 9, 1995

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

 +3       ;NOT AN ENTRY POINT

           QUIT 

PADWRITE  ; ENTRY POINT.

 +1        USE %DEV

           WRITE X,!

 +2        QUIT 

CCTRID    ;EP

 +1        SET AFSUXFNM=$SELECT(AFSCCTR="DPS":"ddps",AFSCCTR="NIH":"nih",AFSCCTR="BCS":"bcbs",AFSCCTR="PCC":"pcc",1:" ")

 +2        SET AFSCCTRN=$SELECT(AFSCCTR="DPS":"IHS Data Center (ALBQ)",AFSCCTR="NIH":"National Inst. of Hlth (Bethesda)",AFSCCTR="BCS":"Blue Cross / Shield (NM)",AFSCCTR="PCC":"Parklawn Computer Center (PCC)",1:"Z")

 +3        QUIT 

CCTRIDR   ;EP

 +1        IF AFSCCTR'="PCC"

               SET AFSRRTYP=$SELECT(AFSCCTR="BCS":"B",AFSCCTR="NIH":"N",AFSCCTR="DPS":"I",1:"X")

               SET Y=AFSRRTYP

 +2       ;S AFSRRTYP=AFSRTYPE

 +3        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

 +5       ;;   %ZA       -- CONTAINS COMPLETION CODE (-1 = ERROR)

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

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

OPENHFS   ;PEP; OPEN FILE IN DIRECTORY

 +1        IF '$DATA(%IN)

               SET %IN=1

 +2        IF '$DATA(%FO)

               SET %FO=0

 +3       ;S ZISH1=$P(%FN,"/",1,4)_"/" ;CSC 7-95   ;ACR*2.1*13.06 IM14144

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

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

 +6       ;ACR*2.1*13.06 IM14144

           NEW ACRDIR,ACRDEL

 +7       ;ACR*2.1*13.06 IM14144

           SET ACRDIR=$$ARMSDIR^ACRFSYS(1)

 +8       ;ACR*2.1*13.06 IM14144

           IF ACRDIR']""

               SET AFSERMSG="M15"

               QUIT 

 +9       ;ACR*2.1*13.06 IM14144

           SET ACRDEL=$EXTRACT(ACRDIR)

 +10      ;CSC 7-95 ;ACR*2.1*13.01 IM13574

           SET ZISH1=$PIECE(%FN,ACRDEL,1,4)_ACRDEL

 +11      ;ACR*2.1*13.06 IM14144

           SET ZISH2=$PIECE(%FN,ACRDEL,5)

 +12      ;ACR*2.1*13.01 IM13574

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

 +13       SET Y=$$OPEN^%ZISH(ZISH1,ZISH2,ZISH3)

 +14      ;I %ZA=-1 S AFSERMSG="M10"

 +15       IF Y'=0

               SET AFSERMSG="M10"

 +16      IF '$TEST

               SET %DEV=IO

 +17       QUIT 

ERROR     ;PEP; WRITES VARIABLE ERROR MESSAGES

 +1        IF '$DATA(AFSERMSG)

               GOTO ERROREX

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

 +3        USE IO(0)

           WRITE !!,*7,?(80-$LENGTH(X)/2),X,!

 +4        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Enter <RETURN> to Continue"

           DO ^DIR

ERROREX    SET AFSJFLG=1

           KILL AFSERMSG

           QUIT 

CRTSETUP  ;PEP; SETS UP VARIABLES FOR CRT

 +1       ;pdw

           IF '$GET(IOST(0))

               DO HOME^%ZIS

 +2        SET XY=$PIECE(^%ZIS(2,IOST(0),1),"^",5)

 +3        IF '$DATA(^%ZIS(1,IOS,"SUBTYPE"))

               GOTO BTRMDEF

 +4        IF '$DATA(^%ZIS(1,IOS,"TYPE"))

               GOTO BTRMDEF

 +5        IF ^%ZIS(1,IOS,"TYPE")'="TRM"&(^%ZIS(1,IOS,"TYPE")'="VTRM")

               GOTO BTRMDEF

 +6        IF '$DATA(^%ZIS(2,IOST(0),5))

               GOTO BTRMDEF

 +7        SET AFSLE=$PIECE(^%ZIS(2,IOST(0),5),"^",6)

 +8        SET AFSLE="W "_AFSLE

 +9        SET AFSRVON=$PIECE(^%ZIS(2,IOST(0),5),"^",4)

 +10       SET AFSRVOF=$PIECE(^%ZIS(2,IOST(0),5),"^",5)

 +11       SET X=0

           XECUTE ^%ZOSF("RM")

 +12       QUIT 

UXFILKIL  ;EP

 +1        SET AFSCMD="rm /usr/bin/3780/RCVFILE*"

 +2       ;CSC 7-95

           SET AFSTCMDR=AFSCMD

           DO HOSTCMD^AFSTCKZC

           KILL AFSTCMDR

 +3        SET AFSCMD="rm /usr/ihs/reports/ddpsnull*"

 +4       ;CSC 7-95

           SET AFSTCMDR=AFSCMD

           DO HOSTCMD^AFSTCKZC

           KILL AFSTCMDR

 +5        QUIT 

BTRMDEF   ;EP

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

           HANG 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

M15       ;;DIRECTORY PATH NOT DEFINED IN FMS SYSTEM DEFAULTS FILE ;;ACR*2.1*13.06 IM14144