APCL3024 ; IHS/CMI/LAB - environment check ;
;;3.0;IHS PCC REPORTS;**24**;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*23") 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
S X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE AGG REPORT","AGIL")
I 'X W "Attempt to add aggregate report option failed." H 3
D MEDTAX
Q
MEDTAX ;
S ATXFLG=1
S APCLX="FLU ANTIVIRAL MEDS",APCLTAX="",APCLNDCT="" D DRUG1 D
.S APCLTX=$O(^ATXAX("B","FLU ANTIVIRAL MEDS",0))
.Q:'APCLTX
.S A=0,B="" F S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A S B=A
.S APCLC=B
.S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J S C=$P(^PSDRUG(J,0),U,1) I $$UP^XLFSTR(C)["OSELTAMIVIR"!($$UP^XLFSTR(C)["ZANAMIVIR") D
..Q:$D(^ATXAX(APCLTX,21,"B",J))
..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J,^ATXAX(APCLTX,21,0)="^9002226.02101A^"_APCLC_U_APCLC
.S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
Q
DRUG1 ;
W !,"Creating ",APCLX," Taxonomy..."
S APCLTX=$O(^ATXAX("B",APCLX,0))
I 'APCLTX D Q:Y=-1
.S X=APCLX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
.I Y=-1 W !!,"ERROR IN CREATING ",APCLX," TAX" Q
.S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)=APCLX,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
I $G(APCLTAX)]"" D
.S A=0,B="" F S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A S B=A
.S APCLC=B
.S ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
.S Z=$O(^ATXAX("B",APCLTAX,0))
.S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J S C=$P($G(^PSDRUG(J,0)),U,2) I C]"",$D(^ATXAX(Z,21,"B",C)) D
..Q:$D(^ATXAX(APCLTX,21,"B",J))
..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J
I $G(APCLNDCT)]"" D
.S A=0,B="" F S A=$O(^ATXAX(APCLTX,21,A)) Q:A'=+A S B=A
.S APCLC=B
.S ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
.S Z=$O(^ATXAX("B",APCLNDCT,0))
.S J=0 F S J=$O(^PSDRUG(J)) Q:J'=+J S C=$P($G(^PSDRUG(J,2)),U,4) I C]"",$D(^ATXAX(Z,21,"B",C)) D
..Q:$D(^ATXAX(APCLTX,21,"B",J))
..S APCLC=APCLC+1,^ATXAX(APCLTX,21,APCLC,0)=J_U_J
S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
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.IHS.GOV;.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
;;
APCL3024 ; IHS/CMI/LAB - environment check ;
+1 ;;3.0;IHS PCC REPORTS;**24**;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*23")
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 ;S DA=$O(^APCLCNTL("B","ILI STOP DATE",0))
+4 ;I 'DA W !!,"ILI CONTROL FILE ENTRY MISSING. NOTIFY PROGRAMMER." K DA Q
+5 ;I $P(^APCLCNTL(DA,0),U,3)>3100801 G POST1
+6 ;S DIE="^APCLCNTL(",DR=".03////3100801"
+7 ;D ^DIE
+8 ;K 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 SET X=$$ADD^XPDMENU("APCL M MAN QUALITY ASSURANCE","APCL SURVEILLANCE AGG REPORT","AGIL")
+7 IF 'X
WRITE "Attempt to add aggregate report option failed."
HANG 3
+8 DO MEDTAX
+9 QUIT
MEDTAX ;
+1 SET ATXFLG=1
+2 SET APCLX="FLU ANTIVIRAL MEDS"
SET APCLTAX=""
SET APCLNDCT=""
DO DRUG1
Begin DoDot:1
+3 SET APCLTX=$ORDER(^ATXAX("B","FLU ANTIVIRAL MEDS",0))
+4 IF 'APCLTX
QUIT
+5 SET A=0
SET B=""
FOR
SET A=$ORDER(^ATXAX(APCLTX,21,A))
IF A'=+A
QUIT
SET B=A
+6 SET APCLC=B
+7 SET J=0
FOR
SET J=$ORDER(^PSDRUG(J))
IF J'=+J
QUIT
SET C=$PIECE(^PSDRUG(J,0),U,1)
IF $$UP^XLFSTR(C)["OSELTAMIVIR"!($$UP^XLFSTR(C)["ZANAMIVIR")
Begin DoDot:2
+8 IF $DATA(^ATXAX(APCLTX,21,"B",J))
QUIT
+9 SET APCLC=APCLC+1
SET ^ATXAX(APCLTX,21,APCLC,0)=J_U_J
SET ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_APCLC_U_APCLC
End DoDot:2
+10 SET DA=APCLTX
SET DIK="^ATXAX("
DO IX1^DIK
End DoDot:1
+11 QUIT
DRUG1 ;
+1 WRITE !,"Creating ",APCLX," Taxonomy..."
+2 SET APCLTX=$ORDER(^ATXAX("B",APCLX,0))
+3 IF 'APCLTX
Begin DoDot:1
+4 SET X=APCLX
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",APCLX," TAX"
QUIT
+6 SET APCLTX=+Y
SET $PIECE(^ATXAX(APCLTX,0),U,2)=APCLX
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=173
SET $PIECE(^(0),U,13)=0
SET $PIECE(^(0),U,15)=50
SET ^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
End DoDot:1
IF Y=-1
QUIT
+7 SET DA=APCLTX
SET DIK="^ATXAX("
DO IX1^DIK
+8 IF $GET(APCLTAX)]""
Begin DoDot:1
+9 SET A=0
SET B=""
FOR
SET A=$ORDER(^ATXAX(APCLTX,21,A))
IF A'=+A
QUIT
SET B=A
+10 SET APCLC=B
+11 SET ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
+12 SET Z=$ORDER(^ATXAX("B",APCLTAX,0))
+13 SET J=0
FOR
SET J=$ORDER(^PSDRUG(J))
IF J'=+J
QUIT
SET C=$PIECE($GET(^PSDRUG(J,0)),U,2)
IF C]""
IF $DATA(^ATXAX(Z,21,"B",C))
Begin DoDot:2
+14 IF $DATA(^ATXAX(APCLTX,21,"B",J))
QUIT
+15 SET APCLC=APCLC+1
SET ^ATXAX(APCLTX,21,APCLC,0)=J_U_J
End DoDot:2
End DoDot:1
+16 IF $GET(APCLNDCT)]""
Begin DoDot:1
+17 SET A=0
SET B=""
FOR
SET A=$ORDER(^ATXAX(APCLTX,21,A))
IF A'=+A
QUIT
SET B=A
+18 SET APCLC=B
+19 SET ^ATXAX(APCLTX,21,0)="^9002226.02101A^"_B_U_B
+20 SET Z=$ORDER(^ATXAX("B",APCLNDCT,0))
+21 SET J=0
FOR
SET J=$ORDER(^PSDRUG(J))
IF J'=+J
QUIT
SET C=$PIECE($GET(^PSDRUG(J,2)),U,4)
IF C]""
IF $DATA(^ATXAX(Z,21,"B",C))
Begin DoDot:2
+22 IF $DATA(^ATXAX(APCLTX,21,"B",J))
QUIT
+23 SET APCLC=APCLC+1
SET ^ATXAX(APCLTX,21,APCLC,0)=J_U_J
End DoDot:2
End DoDot:1
+24 SET DA=APCLTX
SET DIK="^ATXAX("
DO IX1^DIK
+25 QUIT
+26 ;
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.IHS.GOV;.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 ;;
