APCL3023 ; IHS/CMI/LAB - environment check ;
;;3.0;IHS PCC REPORTS;**23**;FEB 05, 1997
;
;
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
I $$VERSION^XPDUTL("BJPC")'="2.0" W !,"version 2.0 of BJPC is required" D SORRY(2)
I $$VERSION^XPDUTL("BGP")'="9.0" W !,"version 9.0 of BGP is required" D SORRY(2)
I '$$INSTALLD("APCL*3.0*22") D SORRY(2)
;
Q
;
PRE ;
Q
POST ;
OPTIONS ;
S X=$$ADD^XPDMENU("APCL M OTHER REPORTS","APCL EDIT SURV ILI STOP DATE","USSD")
I 'X W "Attempt to add APCL EDIT SURV ILI STOP DATE option failed.." H 3
S DA=$O(^APCLCNTL("B","ILI STOP DATE",0))
I 'DA W !!,"ILI CONTROL FILE ENTRY MISSING. NOTIFY PROGRAMMER." K DA Q
I $P(^APCLCNTL(DA,0),U,3)>3100801 G POST1
S DIE="^APCLCNTL(",DR=".03////3100801"
D ^DIE
K DIE,DA
POST1 ;
D CLTAX
D ^APCL23
D ZISH
S X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE ILI TEMPLATE","ILI")
I 'X W "Attempt to add SURVEILLANCE ILI report option failed.." H 3
Q
;
ZISH ;create entry in ZISH SEND PARAMETERS file
D ^XBFMK K DIADD,DLAYGO,DIC,DD,D0,DO
Q:$D(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND"))
S APCLY=0 F S APCLY=$O(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND",0)) Q:APCLY'=+APCLY D
.I APCLY S DA=APCLY,DIK="^%ZIB(9888888.93," D ^DIK K DA,DIK
S X="SURVEILLANCE ILI SEND",DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
I Y=-1 W !!,"error creating ZISH SEND PARAMETERS entry" Q
S DA=+Y,DIE="^%ZIB(9888888.93,",DR=".02///QUOVADX-IE.DOMAIN.NAME;.03///fludata;.04///etgx7h;.06///-u;.07///B;.08///sendto"
D ^DIE
I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry" Q
Q
;
CLTAX ;
S ATXFLG=1
Q:$D(^ATXAX("B","SURVEILLANCE ILI CLINICS"))
W !,"Creating Surveillance ILI Clinics taxonomy..."
S APCLDA=0 S APCLDA=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",APCLDA)) I APCLDA S DA=APCLDA S DIK="^ATXAX(" D ^DIK K DA,DIK
S X="SURVEILLANCE ILI CLINICS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING SURVEILLANCE ILI CLINICS TAX" Q
S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)="SURVEILLANCE ILI CLINICS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=172,$P(^(0),U,13)=0,$P(^(0),U,15)=40.7,^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
D ^XBFMK K DIADD,DLAYGO S APCLTEXT="CLINICS" F APCLX=1:1 S X=$P($T(@APCLTEXT+APCLX),";;",2) Q:X="" S Y=$O(^DIC(40.7,"C",X,0)) I Y D
.S ^ATXAX(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
.Q
S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
Q
;
INSTALLD(APCLSTAL) ;EP - Determine if patch APCLSTAL was installed, where
; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW APCLY,DIC,X,Y
S X=$P(APCLSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(APCLSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(APCLSTAL,"*",3)
D ^DIC
S APCLY=Y
D IMES
Q $S(APCLY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
SORRY(X) ;
KILL DIFQ
I X=3 S XPDQUIT=2 Q
S XPDQUIT=X
W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
Q
CLINICS ;
;;30
;;10
;;12
;;13
;;20
;;24
;;28
;;57
;;70
;;80
;;89
;;01
;;06
;;
APCL3023 ; IHS/CMI/LAB - environment check ;
+1 ;;3.0;IHS PCC REPORTS;**23**;FEB 05, 1997
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move
+5 ; Routines..." questions from being asked during the install.
+6 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+7 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+8 IF $$VERSION^XPDUTL("BJPC")'="2.0"
WRITE !,"version 2.0 of BJPC is required"
DO SORRY(2)
+9 IF $$VERSION^XPDUTL("BGP")'="9.0"
WRITE !,"version 9.0 of BGP is required"
DO SORRY(2)
+10 IF '$$INSTALLD("APCL*3.0*22")
DO SORRY(2)
+11 ;
+12 QUIT
+13 ;
PRE ;
+1 QUIT
POST ;
OPTIONS ;
+1 SET X=$$ADD^XPDMENU("APCL M OTHER REPORTS","APCL EDIT SURV ILI STOP DATE","USSD")
+2 IF 'X
WRITE "Attempt to add APCL EDIT SURV ILI STOP DATE option failed.."
HANG 3
+3 SET DA=$ORDER(^APCLCNTL("B","ILI STOP DATE",0))
+4 IF 'DA
WRITE !!,"ILI CONTROL FILE ENTRY MISSING. NOTIFY PROGRAMMER."
KILL DA
QUIT
+5 IF $PIECE(^APCLCNTL(DA,0),U,3)>3100801
GOTO POST1
+6 SET DIE="^APCLCNTL("
SET DR=".03////3100801"
+7 DO ^DIE
+8 KILL DIE,DA
POST1 ;
+1 DO CLTAX
+2 DO ^APCL23
+3 DO ZISH
+4 SET X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE ILI TEMPLATE","ILI")
+5 IF 'X
WRITE "Attempt to add SURVEILLANCE ILI report option failed.."
HANG 3
+6 QUIT
+7 ;
ZISH ;create entry in ZISH SEND PARAMETERS file
+1 DO ^XBFMK
KILL DIADD,DLAYGO,DIC,DD,D0,DO
+2 IF $DATA(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND"))
QUIT
+3 SET APCLY=0
FOR
SET APCLY=$ORDER(^%ZIB(9888888.93,"B","SURVEILLANCE ILI SEND",0))
IF APCLY'=+APCLY
QUIT
Begin DoDot:1
+4 IF APCLY
SET DA=APCLY
SET DIK="^%ZIB(9888888.93,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+5 SET X="SURVEILLANCE ILI SEND"
SET DIC(0)="L"
SET DIC="^%ZIB(9888888.93,"
DO FILE^DICN
+6 IF Y=-1
WRITE !!,"error creating ZISH SEND PARAMETERS entry"
QUIT
+7 SET DA=+Y
SET DIE="^%ZIB(9888888.93,"
SET DR=".02///QUOVADX-IE.DOMAIN.NAME;.03///fludata;.04///etgx7h;.06///-u;.07///B;.08///sendto"
+8 DO ^DIE
+9 IF $DATA(Y)
WRITE !!,"error updating ZISH SEND PARAMETERS entry"
QUIT
+10 QUIT
+11 ;
CLTAX ;
+1 SET ATXFLG=1
+2 IF $DATA(^ATXAX("B","SURVEILLANCE ILI CLINICS"))
QUIT
+3 WRITE !,"Creating Surveillance ILI Clinics taxonomy..."
+4 SET APCLDA=0
SET APCLDA=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",APCLDA))
IF APCLDA
SET DA=APCLDA
SET DIK="^ATXAX("
DO ^DIK
KILL DA,DIK
+5 SET X="SURVEILLANCE ILI CLINICS"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+6 IF Y=-1
WRITE !!,"ERROR IN CREATING SURVEILLANCE ILI CLINICS TAX"
QUIT
+7 SET APCLTX=+Y
SET $PIECE(^ATXAX(APCLTX,0),U,2)="SURVEILLANCE ILI CLINICS"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=172
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=40.7
SET ^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
+8 DO ^XBFMK
KILL DIADD,DLAYGO
SET APCLTEXT="CLINICS"
FOR APCLX=1:1
SET X=$PIECE($TEXT(@APCLTEXT+APCLX),";;",2)
IF X=""
QUIT
SET Y=$ORDER(^DIC(40.7,"C",X,0))
IF Y
Begin DoDot:1
+9 SET ^ATXAX(APCLTX,21,APCLX,0)=+Y
SET $PIECE(^ATXAX(APCLTX,21,0),U,3)=APCLX
SET $PIECE(^(0),U,4)=APCLX
SET ^ATXAX(APCLTX,21,"AA",+Y,+Y)=""
+10 QUIT
End DoDot:1
+11 SET DA=APCLTX
SET DIK="^ATXAX("
DO IX1^DIK
+12 QUIT
+13 ;
INSTALLD(APCLSTAL) ;EP - Determine if patch APCLSTAL was installed, where
+1 ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW APCLY,DIC,X,Y
+4 SET X=$PIECE(APCLSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(APCLSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(APCLSTAL,"*",3)
+12 DO ^DIC
+13 SET APCLY=Y
+14 DO IMES
+15 QUIT $SELECT(APCLY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_APCLSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
SORRY(X) ;
+1 KILL DIFQ
+2 IF X=3
SET XPDQUIT=2
QUIT
+3 SET XPDQUIT=X
+4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
+5 QUIT
CLINICS ;
+1 ;;30
+2 ;;10
+3 ;;12
+4 ;;13
+5 ;;20
+6 ;;24
+7 ;;28
+8 ;;57
+9 ;;70
+10 ;;80
+11 ;;89
+12 ;;01
+13 ;;06
+14 ;;
