AFSHTCK1 ; IHS/OIRM/DSD/JDM -PART 2 OF GENERIC TELECOMMUNICATION VARIABLE CHECK PROGRAM ; [ 10/27/2004 4:20 PM ]
;;2.0;AO FINANCIAL DATA MGMT SYSTEM;**13**;OCT 12, 1995
;;ACR*2.1*13.04 ROUTINE WILL BE REMOVED
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; OPENS FLAT FILE IN GIVEN DIRECTORY
I '$D(%IN) S %IN=1
I '$D(%FO) S %FO=0
S ZISH1=$P(%FN,"/",1,4)_"/" ;CSC 7-95
S ZISH2=$P(%FN,"/",5)
S ZISH3=$S(%IN=1:"R",%IN=0:"M",1:"R")
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
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
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 AFSHRVON=$P(^%ZIS(2,IOST(0),5),"^",4)
S AFSHRVOF=$P(^%ZIS(2,IOST(0),5),"^",5)
S X=0 X ^%ZOSF("RM")
Q
UXFILKIL ;EP
S AFSCMD="rm /usr/bin/3780/RCVFILE*"
S AFSHCMDR=AFSCMD D HOSTCMD^AFSHCKZC K AFSHCMDR ;CSC 7-95
S AFSCMD="rm /usr/ihs/reports/ddpsnull*"
S AFSHCMDR=AFSCMD D HOSTCMD^AFSHCKZC K AFSHCMDR ;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
AFSHTCK1 ; IHS/OIRM/DSD/JDM -PART 2 OF GENERIC TELECOMMUNICATION VARIABLE CHECK PROGRAM ; [ 10/27/2004 4:20 PM ]
+1 ;;2.0;AO FINANCIAL DATA MGMT SYSTEM;**13**;OCT 12, 1995
+2 ;;ACR*2.1*13.04 ROUTINE WILL BE REMOVED
+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; OPENS FLAT FILE IN GIVEN DIRECTORY
+1 IF '$DATA(%IN)
SET %IN=1
+2 IF '$DATA(%FO)
SET %FO=0
+3 ;CSC 7-95
SET ZISH1=$PIECE(%FN,"/",1,4)_"/"
+4 SET ZISH2=$PIECE(%FN,"/",5)
+5 SET ZISH3=$SELECT(%IN=1:"R",%IN=0:"M",1:"R")
+6 SET Y=$$OPEN^%ZISH(ZISH1,ZISH2,ZISH3)
+7 ;I %ZA=-1 S AFSERMSG="M10"
+8 IF Y'=0
SET AFSERMSG="M10"
+9 IF '$TEST
SET %DEV=IO
+10 QUIT
ERROR ;PEP
+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
+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 AFSHRVON=$PIECE(^%ZIS(2,IOST(0),5),"^",4)
+10 SET AFSHRVOF=$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 AFSHCMDR=AFSCMD
DO HOSTCMD^AFSHCKZC
KILL AFSHCMDR
+3 SET AFSCMD="rm /usr/ihs/reports/ddpsnull*"
+4 ;CSC 7-95
SET AFSHCMDR=AFSCMD
DO HOSTCMD^AFSHCKZC
KILL AFSHCMDR
+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