BJPC2P5 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;
;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
;
;
; 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
;KERNEL
I +$$VERSION^XPDUTL("XU")<8 D MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
;FILEMAN
I +$$VERSION^XPDUTL("DI")<22 D MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
;BJPC
I $$VERSION^XPDUTL("BJPC")'="2.0" D MES^XPDUTL($$CJ^XLFSTR("Version 2.0 of the IHS PCC SUITE (BJPC) is required. Not installed",80)) D SORRY(2) I 1
E D MES^XPDUTL($$CJ^XLFSTR("Requires IHS PCC Suite (BJPC) Version 2.0....Present.",80))
;BJPC 2.0 PATCH 4
I '$$INSTALLD("BJPC*2.0*4") D SORRY(2)
I '$$INSTALLD("APCL*3.0*27") D SORRY(2)
I '$$INSTALLD("AUPN*99.1*21") D SORRY(2)
I '$$INSTALLD("AG*7.1*8") D SORRY(2)
I '$$INSTALLD("HL*1.6*1006") D SORRY(2)
;
Q
;
PRE ;
S BJPCDA=$O(^APCHSCMP("B","MEASUREMENT PANELS (OUTPATIENT)",0))
I BJPCDA S DA=BJPCDA,DR=".01///MEASUREMENT PANELS",DIE="^APCHSCMP(" D ^DIE K DA,DIE,DR
S BJPCDA=$O(^APCHSCMP("B","PROBLEMS - INACTIVE/RESOLVED",0))
I BJPCDA S DA=BJPCDA,DR=".01///PROBLEMS - INACTIVE;3///INACTIVE PROBLEMS",DIE="^APCHSCMP(" D ^DIE K DA,DIE,DR
S DA=0 F S DA=$O(^APCLVSTS(DA)) Q:DA'=+DA S DIK="^APCLVSTS(" D ^DIK
S DA=0 F S DA=$O(^APCDTHFD(DA)) Q:DA'=+DA S DIK="^APCDTHFD(" D ^DIK
S DA=$O(^APCDTKW("B","PRO",0)) I DA S DIK="^APCDTKW(" D ^DIK
K DA,DIK
S DA=$O(^APCDTKW("B","MEAS",0))
I DA S DIE="^APCDTKW(",DR=".07///0" D ^DIE K DA,DIE,DR
D PRE^AMQQPOST
Q
POST ;
;ADD EPI OPTIONS
S X=$$ADD^XPDMENU("APCLMENU","APCS EPI PROGRAM HL7 EXPORTS","EPIX")
I 'X W !,"Attempt to add APCS EPI PROGRAM HL7 EXPORTS option failed.." H 3
S X=$$DELETE^XPDMENU("APCLMENU","APCL M MAIN DM MENU")
S X=$$ADD^XPDMENU("APCLMENU","APCL TAXONOMY SETUP","TS")
D LAB
D HLO
D ^APCS
D POST^AMQQPOST
D HF
HSHF ;
;now fix health summary types to add 3 categories if the tobacco one is in the health factor multiple
S BJPCX=0 F S BJPCX=$O(^APCHSCTL(BJPCX)) Q:BJPCX'=+BJPCX D
.Q:'$O(^APCHSCTL(BJPCX,7,0)) ;no health factor categories defined
.;GET THE LAST ORDER NUMBER USED
.S (X,BJPCL)="" F S X=$O(^APCHSCTL(BJPCX,7,"B",X)) Q:X'=+X S BJPCL=X
.S (X,BJPCI)="" F S X=$O(^APCHSCTL(BJPCX,7,X)) Q:X'=+X S BJPCI=X
.S BJPCY=0 F S BJPCY=$O(^APCHSCTL(BJPCX,7,BJPCY)) Q:BJPCY'=+BJPCY D
..S BJPCC=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)
..;don't bother if this is not TOBACCO
..Q:'BJPCC
..Q:$P($G(^AUTTHF(BJPCC,0)),U,1)'="TOBACCO"
..S BJPCO=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,1)
..;CHANGE THIS ONE TO TOBACCO (SMOKING)
..S X=$O(^AUTTHF("B","TOBACCO (SMOKING)",0))
..Q:'X
..S $P(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)=X,$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,3)="Tobacco Use (Smoking)"
..S BJPCYN=$P(^APCHSCTL(BJPCX,7,BJPCY,0),U,4)
..;NO INDEXES
..S BJPCN=BJPCO+1,BJPCIE=BJPCI+1 I $D(^APCHSCTL(BJPCX,7,"B",BJPCN)) S BJPCN=BJPCL+1
..S X=$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
..I X D
...S ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco Use (Smokeless)"_U_BJPCYN
...S ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
..S BJPCN=BJPCO+2,BJPCIE=BJPCI+2 I $D(^APCHSCTL(BJPCX,7,"B",BJPCN)) S BJPCN=BJPCL+2
..S X=$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
..I X D
...S ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco (Exposure)"_U_BJPCYN
...S ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
Q
HF ;
;UPDATE HEALTH FACTOR TABLE AND V HEALTH FACTOR DATA
;inactivate category TOBACCO as it has been broken into 3 categories
S DA=$O(^AUTTHF("B","TOBACCO",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;add 3 new categories
;TOBACCO (SMOKING)
I '$O(^AUTTHF("B","TOBACCO (SMOKING)",0)) D
.S X="TOBACCO (SMOKING)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKING)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKING) failed") Q
;TOBACCO (SMOKLESS - CHEWING DIP)
I '$O(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0)) D
.S X="TOBACCO (SMOKELESS - CHEWING/DIP)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (SMOKELESS - CHEWING/DIP)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKELESS - CHEWING/DIP) failed") Q
;TOBACCO (EXPOSURE)
I '$O(^AUTTHF("B","TOBACCO (EXPOSURE)",0)) D
.S X="TOBACCO (EXPOSURE)",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///C;.03///TOBACCO (EXPOSURE)" D FILE^DICN K DIADD,DLAYGO,DIC,X
.I Y=-1 D MES^XPDUTL("Adding Health Factor Category TOBACCO (EXPOSURE) failed") Q
;change names of 3 health factors
;CURRENT SMOKER - CURRENT SMOKER, STATUS UNKNOWN
S DA=$O(^AUTTHF("B","CURRENT SMOKER",0))
I DA S DIE="^AUTTHF(",DR=".01///CURRENT SMOKER, STATUS UNKNOWN" D ^DIE K DA,DIE,DR
;PREVIOUS SMOKER - PREVIOUS (FORMER) SMOKER
S DA=$O(^AUTTHF("B","PREVIOUS SMOKER",0))
I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKER" D ^DIE K DA,DIE,DR
;PREVIOUS SMOKELESS - PREVIOUS (FORMER) SMOKELESS
S DA=$O(^AUTTHF("B","PREVIOUS SMOKELESS",0))
I DA S DIE="^AUTTHF(",DR=".01///PREVIOUS (FORMER) SMOKELESS" D ^DIE K DA,DIE,DR
;INACTIVATE 2 HEALTH FACTORS
;CURRENT SMOKER AND SMOKELESS
S DA=$O(^AUTTHF("B","CURRENT SMOKER & SMOKELESS",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;NEVER USED TOBACCO
S DA=$O(^AUTTHF("B","NEVER USED TOBACCO",0))
I DA,$P(^AUTTHF(DA,0),U,15)="" S DIE="^AUTTHF(",DR=".13///1;.15////"_DT D ^DIE K DA,DIE,DR
;ADD 6 NEW HEALTH FACTORS
F BJPCX="CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","NEVER SMOKED","SMOKING STATUS UNKNOWN","SMOKELESS TOBACCO, STATUS UNKNOWN","NEVER USED SMOKELESS TOBACCO" D
.Q:$D(^AUTTHF("B",BJPCX))
.S X=BJPCX,DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F" D FILE^DICN K DIC,X,DIADD,DLAYGO
.I Y=-1 D MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
;UPDATE CATEGORY ON ALL NEW HEALTH FACTORS
F BJPCX="NON-TOBACCO USER","CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","CURRENT SMOKER, STATUS UNKNOWN","CESSATION-SMOKER","PREVIOUS (FORMER) SMOKER","CEREMONIAL USE ONLY","NEVER SMOKED","SMOKING STATUS UNKNOWN" D
.S DA=$O(^AUTTHF("B",BJPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKING)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
F BJPCX="CURRENT SMOKELESS","CESSATION-SMOKELESS","PREVIOUS (FORMER) SMOKELESS","NEVER USED SMOKELESS TOBACCO","SMOKELESS TOBACCO, STATUS UNKNOWN" D
.S DA=$O(^AUTTHF("B",BJPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (SMOKELESS - CHEWING/DIP)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
F BJPCX="SMOKER IN HOME","SMOKE FREE HOME","EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE" D
.S DA=$O(^AUTTHF("B",BJPCX,0))
.I 'DA D MES^XPDUTL("updating category for "_BJPCX_" failed.") Q
.S DIE="^AUTTHF(",DR=".03///TOBACCO (EXPOSURE)" D ^DIE K DA,DR,DIE
.I $D(Y) D MES^XPDUTL("Updating category for "_BJPCX_" failed.")
HFDATA ;
;UPDATE V HEALTH FACTORS
;IF PATIENT HAS CURRENT SMOKER AND SMOKELESS THEN ADD CURRENT SMOKER, STATUS UNKNOWN AND CURRENT SMOKELESS
;IF PATIENT HAS NEVER USED TOBACCO THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
;IF PATIENT HAS NON-TOBACCO USER THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
S BJPCDA=0 F S BJPCDA=$O(^AUPNVHF(BJPCDA)) Q:BJPCDA'=+BJPCDA D
.I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="CURRENT SMOKER & SMOKELESS" D Q
..;add 2 new v health factors
..S BJPCNEW="CURRENT SMOKER, STATUS UNKNOWN"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
..S BJPCNEW="CURRENT SMOKELESS"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
.I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NON-TOBACCO USER" D Q
..;add 2 new v health factors
..S BJPCNEW="NEVER SMOKED"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
..S BJPCNEW="NEVER USED SMOKELESS TOBACCO"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
.I $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NEVER USED TOBACCO" D Q
..;add 2 new v health factors
..S BJPCNEW="NEVER SMOKED"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
..S BJPCNEW="NEVER USED SMOKELESS TOBACCO"
..I '$$GOTHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW) D ADDHF($P(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
CODE ;now update all HF Codes per Floyd's spreadsheet
S BJPCX=0 F S BJPCX=$O(^APCDTHFD(BJPCX)) Q:BJPCX'=+BJPCX D
.S BJPCHF=$P(^APCDTHFD(BJPCX,0),U,1)
.S BJPCHFC=$P(^APCDTHFD(BJPCX,0),U,2)
.S BJPCHFN=$P($G(^APCDTHFD(BJPCX,88)),U,1)
.S DA=$O(^AUTTHF("B",BJPCHF,0))
.Q:'DA
.I DA S DIE="^AUTTHF(",DR=".02///"_BJPCHFC_";8801///"_BJPCHFN
.D ^DIE
.K DA,DIE,DR
;now add LOW HEALTH LITERACY READINESS TO LEARN PER Floyd
Q:$D(^AUTTHF("C","F112")) ;already there
S BJPCC=$O(^AUTTHF("B","BARRIERS TO LEARNING",0))
S X="LOW HEALTH LITERACY",DIC="^AUTTHF(",DIC(0)="L",DIADD=1,DLAYGO=9999999.64,DIC("DR")=".1///F;.03////"_BJPCC_";.02////F112" D FILE^DICN K DIC,X,DIADD,DLAYGO
I Y=-1 D MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
Q
GOTHF(VISIT,HF) ;is this hf already attached to this visit?
NEW X,G
S G=0
S X=0 F S X=$O(^AUPNVHF("AD",VISIT,X)) Q:X'=+X!(G) I $D(^AUPNVHF(X,0)),$$VAL^XBDIQ1(9000010.23,X,.01)=BJPCNEW S G=1
Q G
ADDHF(VISIT,HF,HFDA) ;add this v health factor to visit
I '$G(VISIT) Q
I '$D(^AUPNVSIT(VISIT,0)) Q
;SET UP ARRAY WITH SAME VALUES AS THE OTHER ENTRY
N BJPCFDA,BJPCIENS,BJPCERRR,BJPCPIEN,DITC
S DITC=1
S BJPCIENS="+1,"
S BJPCFDA(9000010.23,BJPCIENS,.01)=$O(^AUTTHF("B",HF,0))
S BJPCFDA(9000010.23,BJPCIENS,.02)=$P(^AUPNVHF(HFDA,0),U,2)
S BJPCFDA(9000010.23,BJPCIENS,.03)=VISIT
I $P(^AUPNVHF(HFDA,0),U,4)]"" S BJPCFDA(9000010.23,BJPCIENS,.04)=$P(^AUPNVHF(HFDA,0),U,4)
I $P(^AUPNVHF(HFDA,0),U,5)]"" S BJPCFDA(9000010.23,BJPCIENS,.05)=$P(^AUPNVHF(HFDA,0),U,5)
I $P(^AUPNVHF(HFDA,0),U,6)]"" S BJPCFDA(9000010.23,BJPCIENS,.06)=$P(^AUPNVHF(HFDA,0),U,6)
I $P($G(^AUPNVHF(HFDA,12)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,1201)=$P($G(^AUPNVHF(HFDA,12)),U,1)
I $P($G(^AUPNVHF(HFDA,12)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,1202)=$P($G(^AUPNVHF(HFDA,12)),U,2)
I $P($G(^AUPNVHF(HFDA,12)),U,3)]"" S BJPCFDA(9000010.23,BJPCIENS,1203)=$P($G(^AUPNVHF(HFDA,12)),U,3)
I $P($G(^AUPNVHF(HFDA,12)),U,4)]"" S BJPCFDA(9000010.23,BJPCIENS,1204)=$P($G(^AUPNVHF(HFDA,12)),U,4)
I $P($G(^AUPNVHF(HFDA,12)),U,8)]"" S BJPCFDA(9000010.23,BJPCIENS,1208)=$P($G(^AUPNVHF(HFDA,12)),U,8)
I $P($G(^AUPNVHF(HFDA,12)),U,9)]"" S BJPCFDA(9000010.23,BJPCIENS,1209)=$P($G(^AUPNVHF(HFDA,12)),U,9)
I $P($G(^AUPNVHF(HFDA,12)),U,10)]"" S BJPCFDA(9000010.23,BJPCIENS,1210)=$P($G(^AUPNVHF(HFDA,12)),U,10)
I $P($G(^AUPNVHF(HFDA,12)),U,15)]"" S BJPCFDA(9000010.23,BJPCIENS,1215)=$P($G(^AUPNVHF(HFDA,12)),U,15)
I $P($G(^AUPNVHF(HFDA,801)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,80101)=$P($G(^AUPNVHF(HFDA,801)),U,1)
I $P($G(^AUPNVHF(HFDA,801)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,80102)=$P($G(^AUPNVHF(HFDA,801)),U,2)
I $P($G(^AUPNVHF(HFDA,811)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,81101)=$P($G(^AUPNVHF(HFDA,811)),U,1)
I $P($G(^AUPNVHF(HFDA,812)),U,1)]"" S BJPCFDA(9000010.23,BJPCIENS,81201)=$P($G(^AUPNVHF(HFDA,812)),U,1)
I $P($G(^AUPNVHF(HFDA,812)),U,2)]"" S BJPCFDA(9000010.23,BJPCIENS,81202)=$P($G(^AUPNVHF(HFDA,812)),U,2)
I $P($G(^AUPNVHF(HFDA,812)),U,3)]"" S BJPCFDA(9000010.23,BJPCIENS,81203)=$P($G(^AUPNVHF(HFDA,812)),U,1)
D UPDATE^DIE("","BJPCFDA","BJPCIENS","BJPCERRR(1)")
I $D(BJPCERRR) D MES^XPDUTL("Error creating V Health Factor "_HF_" for visit ien "_VISIT_".") Q
W "."
Q
;
LAB ;EP
S APCSX="SURVEILLANCE RAPID FLU TESTS" D LAB1
;D HLO
Q
LAB1 ;
S APCSDA=$O(^ATXLAB("B",APCSX,0))
Q:APCSDA ;taxonomy already exisits
W !,"Creating ",APCSX," Taxonomy..."
S X=APCSX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
I Y=-1 W !!,"ERROR IN CREATING ",APCSX," TAX" Q
S APCSTX=+Y,$P(^ATXLAB(APCSTX,0),U,2)=APCSX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60
S ^ATXLAB(APCSTX,21,0)="^9002228.02101PA^0^0"
S DA=APCSTX,DIK="^ATXAX(" D IX1^DIK
Q
;
HLO ;--register the app in HLO
N FDA,FIENS,FERR,PCCI
Q:$O(^HLD(779.2,"B","RPMS-ILI",0))
S PCCI=$O(^DIC(9.4,"B","IHS PCC SUITE",0))
Q:'PCCI
S FIENS=""
S FDA(779.2,"+1,",.01)="RPMS-ILI"
S FDA(779.2,"+1,",2)=PCCI
D UPDATE^DIE("","FDA","FIENS","FERR(1)")
Q
INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW BJPCY,DIC,X,Y
S X=$P(BJPCSTAL,"*",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(BJPCSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(BJPCSTAL,"*",3)
D ^DIC
S BJPCY=Y
D IMES
Q $S(BJPCY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" 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
BJPC2P5 ; IHS/CMI/LAB - PCC Suite v1.0 patch 3 environment check ;
+1 ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
+2 ;
+3 ;
+4 ; The following line prevents the "Disable Options..." and "Move Routines..." questions from being asked during the install.
+5 IF $GET(XPDENV)=1
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
SET XPDDIQ(X)=0
+7 ;KERNEL
+8 IF +$$VERSION^XPDUTL("XU")<8
DO MES^XPDUTL($$CJ^XLFSTR("Version 8.0 of KERNEL is required. Not installed",80))
DO SORRY(2)
IF 1
+9 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Kernel Version 8.0....Present.",80))
+10 ;FILEMAN
+11 IF +$$VERSION^XPDUTL("DI")<22
DO MES^XPDUTL($$CJ^XLFSTR("Version 22.0 of FILEMAN is required. Not installed.",80))
DO SORRY(2)
IF 1
+12 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires Fileman v22....Present.",80))
+13 ;BJPC
+14 IF $$VERSION^XPDUTL("BJPC")'="2.0"
DO MES^XPDUTL($$CJ^XLFSTR("Version 2.0 of the IHS PCC SUITE (BJPC) is required. Not installed",80))
DO SORRY(2)
IF 1
+15 IF '$TEST
DO MES^XPDUTL($$CJ^XLFSTR("Requires IHS PCC Suite (BJPC) Version 2.0....Present.",80))
+16 ;BJPC 2.0 PATCH 4
+17 IF '$$INSTALLD("BJPC*2.0*4")
DO SORRY(2)
+18 IF '$$INSTALLD("APCL*3.0*27")
DO SORRY(2)
+19 IF '$$INSTALLD("AUPN*99.1*21")
DO SORRY(2)
+20 IF '$$INSTALLD("AG*7.1*8")
DO SORRY(2)
+21 IF '$$INSTALLD("HL*1.6*1006")
DO SORRY(2)
+22 ;
+23 QUIT
+24 ;
PRE ;
+1 SET BJPCDA=$ORDER(^APCHSCMP("B","MEASUREMENT PANELS (OUTPATIENT)",0))
+2 IF BJPCDA
SET DA=BJPCDA
SET DR=".01///MEASUREMENT PANELS"
SET DIE="^APCHSCMP("
DO ^DIE
KILL DA,DIE,DR
+3 SET BJPCDA=$ORDER(^APCHSCMP("B","PROBLEMS - INACTIVE/RESOLVED",0))
+4 IF BJPCDA
SET DA=BJPCDA
SET DR=".01///PROBLEMS - INACTIVE;3///INACTIVE PROBLEMS"
SET DIE="^APCHSCMP("
DO ^DIE
KILL DA,DIE,DR
+5 SET DA=0
FOR
SET DA=$ORDER(^APCLVSTS(DA))
IF DA'=+DA
QUIT
SET DIK="^APCLVSTS("
DO ^DIK
+6 SET DA=0
FOR
SET DA=$ORDER(^APCDTHFD(DA))
IF DA'=+DA
QUIT
SET DIK="^APCDTHFD("
DO ^DIK
+7 SET DA=$ORDER(^APCDTKW("B","PRO",0))
IF DA
SET DIK="^APCDTKW("
DO ^DIK
+8 KILL DA,DIK
+9 SET DA=$ORDER(^APCDTKW("B","MEAS",0))
+10 IF DA
SET DIE="^APCDTKW("
SET DR=".07///0"
DO ^DIE
KILL DA,DIE,DR
+11 DO PRE^AMQQPOST
+12 QUIT
POST ;
+1 ;ADD EPI OPTIONS
+2 SET X=$$ADD^XPDMENU("APCLMENU","APCS EPI PROGRAM HL7 EXPORTS","EPIX")
+3 IF 'X
WRITE !,"Attempt to add APCS EPI PROGRAM HL7 EXPORTS option failed.."
HANG 3
+4 SET X=$$DELETE^XPDMENU("APCLMENU","APCL M MAIN DM MENU")
+5 SET X=$$ADD^XPDMENU("APCLMENU","APCL TAXONOMY SETUP","TS")
+6 DO LAB
+7 DO HLO
+8 DO ^APCS
+9 DO POST^AMQQPOST
+10 DO HF
HSHF ;
+1 ;now fix health summary types to add 3 categories if the tobacco one is in the health factor multiple
+2 SET BJPCX=0
FOR
SET BJPCX=$ORDER(^APCHSCTL(BJPCX))
IF BJPCX'=+BJPCX
QUIT
Begin DoDot:1
+3 ;no health factor categories defined
IF '$ORDER(^APCHSCTL(BJPCX,7,0))
QUIT
+4 ;GET THE LAST ORDER NUMBER USED
+5 SET (X,BJPCL)=""
FOR
SET X=$ORDER(^APCHSCTL(BJPCX,7,"B",X))
IF X'=+X
QUIT
SET BJPCL=X
+6 SET (X,BJPCI)=""
FOR
SET X=$ORDER(^APCHSCTL(BJPCX,7,X))
IF X'=+X
QUIT
SET BJPCI=X
+7 SET BJPCY=0
FOR
SET BJPCY=$ORDER(^APCHSCTL(BJPCX,7,BJPCY))
IF BJPCY'=+BJPCY
QUIT
Begin DoDot:2
+8 SET BJPCC=$PIECE(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)
+9 ;don't bother if this is not TOBACCO
+10 IF 'BJPCC
QUIT
+11 IF $PIECE($GET(^AUTTHF(BJPCC,0)),U,1)'="TOBACCO"
QUIT
+12 SET BJPCO=$PIECE(^APCHSCTL(BJPCX,7,BJPCY,0),U,1)
+13 ;CHANGE THIS ONE TO TOBACCO (SMOKING)
+14 SET X=$ORDER(^AUTTHF("B","TOBACCO (SMOKING)",0))
+15 IF 'X
QUIT
+16 SET $PIECE(^APCHSCTL(BJPCX,7,BJPCY,0),U,2)=X
SET $PIECE(^APCHSCTL(BJPCX,7,BJPCY,0),U,3)="Tobacco Use (Smoking)"
+17 SET BJPCYN=$PIECE(^APCHSCTL(BJPCX,7,BJPCY,0),U,4)
+18 ;NO INDEXES
+19 SET BJPCN=BJPCO+1
SET BJPCIE=BJPCI+1
IF $DATA(^APCHSCTL(BJPCX,7,"B",BJPCN))
SET BJPCN=BJPCL+1
+20 SET X=$ORDER(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
+21 IF X
Begin DoDot:3
+22 SET ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco Use (Smokeless)"_U_BJPCYN
+23 SET ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
End DoDot:3
+24 SET BJPCN=BJPCO+2
SET BJPCIE=BJPCI+2
IF $DATA(^APCHSCTL(BJPCX,7,"B",BJPCN))
SET BJPCN=BJPCL+2
+25 SET X=$ORDER(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
+26 IF X
Begin DoDot:3
+27 SET ^APCHSCTL(BJPCX,7,BJPCIE,0)=BJPCN_U_X_U_"Tobacco (Exposure)"_U_BJPCYN
+28 SET ^APCHSCTL(BJPCX,7,"B",BJPCN,BJPCIE)=""
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
HF ;
+1 ;UPDATE HEALTH FACTOR TABLE AND V HEALTH FACTOR DATA
+2 ;inactivate category TOBACCO as it has been broken into 3 categories
+3 SET DA=$ORDER(^AUTTHF("B","TOBACCO",0))
+4 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+5 ;add 3 new categories
+6 ;TOBACCO (SMOKING)
+7 IF '$ORDER(^AUTTHF("B","TOBACCO (SMOKING)",0))
Begin DoDot:1
+8 SET X="TOBACCO (SMOKING)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (SMOKING)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+9 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKING) failed")
QUIT
End DoDot:1
+10 ;TOBACCO (SMOKLESS - CHEWING DIP)
+11 IF '$ORDER(^AUTTHF("B","TOBACCO (SMOKELESS - CHEWING/DIP)",0))
Begin DoDot:1
+12 SET X="TOBACCO (SMOKELESS - CHEWING/DIP)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (SMOKELESS - CHEWING/DIP)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+13 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (SMOKELESS - CHEWING/DIP) failed")
QUIT
End DoDot:1
+14 ;TOBACCO (EXPOSURE)
+15 IF '$ORDER(^AUTTHF("B","TOBACCO (EXPOSURE)",0))
Begin DoDot:1
+16 SET X="TOBACCO (EXPOSURE)"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///C;.03///TOBACCO (EXPOSURE)"
DO FILE^DICN
KILL DIADD,DLAYGO,DIC,X
+17 IF Y=-1
DO MES^XPDUTL("Adding Health Factor Category TOBACCO (EXPOSURE) failed")
QUIT
End DoDot:1
+18 ;change names of 3 health factors
+19 ;CURRENT SMOKER - CURRENT SMOKER, STATUS UNKNOWN
+20 SET DA=$ORDER(^AUTTHF("B","CURRENT SMOKER",0))
+21 IF DA
SET DIE="^AUTTHF("
SET DR=".01///CURRENT SMOKER, STATUS UNKNOWN"
DO ^DIE
KILL DA,DIE,DR
+22 ;PREVIOUS SMOKER - PREVIOUS (FORMER) SMOKER
+23 SET DA=$ORDER(^AUTTHF("B","PREVIOUS SMOKER",0))
+24 IF DA
SET DIE="^AUTTHF("
SET DR=".01///PREVIOUS (FORMER) SMOKER"
DO ^DIE
KILL DA,DIE,DR
+25 ;PREVIOUS SMOKELESS - PREVIOUS (FORMER) SMOKELESS
+26 SET DA=$ORDER(^AUTTHF("B","PREVIOUS SMOKELESS",0))
+27 IF DA
SET DIE="^AUTTHF("
SET DR=".01///PREVIOUS (FORMER) SMOKELESS"
DO ^DIE
KILL DA,DIE,DR
+28 ;INACTIVATE 2 HEALTH FACTORS
+29 ;CURRENT SMOKER AND SMOKELESS
+30 SET DA=$ORDER(^AUTTHF("B","CURRENT SMOKER & SMOKELESS",0))
+31 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+32 ;NEVER USED TOBACCO
+33 SET DA=$ORDER(^AUTTHF("B","NEVER USED TOBACCO",0))
+34 IF DA
IF $PIECE(^AUTTHF(DA,0),U,15)=""
SET DIE="^AUTTHF("
SET DR=".13///1;.15////"_DT
DO ^DIE
KILL DA,DIE,DR
+35 ;ADD 6 NEW HEALTH FACTORS
+36 FOR BJPCX="CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","NEVER SMOKED","SMOKING STATUS UNKNOWN","SMOKELESS TOBACCO, STATUS UNKNOWN","NEVER USED SMOKELESS TOBACCO"
Begin DoDot:1
+37 IF $DATA(^AUTTHF("B",BJPCX))
QUIT
+38 SET X=BJPCX
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///F"
DO FILE^DICN
KILL DIC,X,DIADD,DLAYGO
+39 IF Y=-1
DO MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
End DoDot:1
+40 ;UPDATE CATEGORY ON ALL NEW HEALTH FACTORS
+41 FOR BJPCX="NON-TOBACCO USER","CURRENT SMOKER, EVERY DAY","CURRENT SMOKER, SOME DAY","CURRENT SMOKER, STATUS UNKNOWN","CESSATION-SMOKER","PREVIOUS (FORMER) SMOKER","CEREMONIAL USE ONLY","NEVER SMOKED","SMOKING STATUS UNKNOWN"
Begin DoDot:1
+42 SET DA=$ORDER(^AUTTHF("B",BJPCX,0))
+43 IF 'DA
DO MES^XPDUTL("updating category for "_BJPCX_" failed.")
QUIT
+44 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (SMOKING)"
DO ^DIE
KILL DA,DR,DIE
+45 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_BJPCX_" failed.")
End DoDot:1
+46 FOR BJPCX="CURRENT SMOKELESS","CESSATION-SMOKELESS","PREVIOUS (FORMER) SMOKELESS","NEVER USED SMOKELESS TOBACCO","SMOKELESS TOBACCO, STATUS UNKNOWN"
Begin DoDot:1
+47 SET DA=$ORDER(^AUTTHF("B",BJPCX,0))
+48 IF 'DA
DO MES^XPDUTL("updating category for "_BJPCX_" failed.")
QUIT
+49 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (SMOKELESS - CHEWING/DIP)"
DO ^DIE
KILL DA,DR,DIE
+50 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_BJPCX_" failed.")
End DoDot:1
+51 FOR BJPCX="SMOKER IN HOME","SMOKE FREE HOME","EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE"
Begin DoDot:1
+52 SET DA=$ORDER(^AUTTHF("B",BJPCX,0))
+53 IF 'DA
DO MES^XPDUTL("updating category for "_BJPCX_" failed.")
QUIT
+54 SET DIE="^AUTTHF("
SET DR=".03///TOBACCO (EXPOSURE)"
DO ^DIE
KILL DA,DR,DIE
+55 IF $DATA(Y)
DO MES^XPDUTL("Updating category for "_BJPCX_" failed.")
End DoDot:1
HFDATA ;
+1 ;UPDATE V HEALTH FACTORS
+2 ;IF PATIENT HAS CURRENT SMOKER AND SMOKELESS THEN ADD CURRENT SMOKER, STATUS UNKNOWN AND CURRENT SMOKELESS
+3 ;IF PATIENT HAS NEVER USED TOBACCO THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
+4 ;IF PATIENT HAS NON-TOBACCO USER THEN ADD NEVER SMOKED AND NEVER USED SMOKELESS TOBACCO
+5 SET BJPCDA=0
FOR
SET BJPCDA=$ORDER(^AUPNVHF(BJPCDA))
IF BJPCDA'=+BJPCDA
QUIT
Begin DoDot:1
+6 IF $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="CURRENT SMOKER & SMOKELESS"
Begin DoDot:2
+7 ;add 2 new v health factors
+8 SET BJPCNEW="CURRENT SMOKER, STATUS UNKNOWN"
+9 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
+10 SET BJPCNEW="CURRENT SMOKELESS"
+11 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
End DoDot:2
QUIT
+12 IF $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NON-TOBACCO USER"
Begin DoDot:2
+13 ;add 2 new v health factors
+14 SET BJPCNEW="NEVER SMOKED"
+15 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
+16 SET BJPCNEW="NEVER USED SMOKELESS TOBACCO"
+17 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
End DoDot:2
QUIT
+18 IF $$VAL^XBDIQ1(9000010.23,BJPCDA,.01)="NEVER USED TOBACCO"
Begin DoDot:2
+19 ;add 2 new v health factors
+20 SET BJPCNEW="NEVER SMOKED"
+21 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
+22 SET BJPCNEW="NEVER USED SMOKELESS TOBACCO"
+23 IF '$$GOTHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW)
DO ADDHF($PIECE(^AUPNVHF(BJPCDA,0),U,3),BJPCNEW,BJPCDA)
End DoDot:2
QUIT
End DoDot:1
CODE ;now update all HF Codes per Floyd's spreadsheet
+1 SET BJPCX=0
FOR
SET BJPCX=$ORDER(^APCDTHFD(BJPCX))
IF BJPCX'=+BJPCX
QUIT
Begin DoDot:1
+2 SET BJPCHF=$PIECE(^APCDTHFD(BJPCX,0),U,1)
+3 SET BJPCHFC=$PIECE(^APCDTHFD(BJPCX,0),U,2)
+4 SET BJPCHFN=$PIECE($GET(^APCDTHFD(BJPCX,88)),U,1)
+5 SET DA=$ORDER(^AUTTHF("B",BJPCHF,0))
+6 IF 'DA
QUIT
+7 IF DA
SET DIE="^AUTTHF("
SET DR=".02///"_BJPCHFC_";8801///"_BJPCHFN
+8 DO ^DIE
+9 KILL DA,DIE,DR
End DoDot:1
+10 ;now add LOW HEALTH LITERACY READINESS TO LEARN PER Floyd
+11 ;already there
IF $DATA(^AUTTHF("C","F112"))
QUIT
+12 SET BJPCC=$ORDER(^AUTTHF("B","BARRIERS TO LEARNING",0))
+13 SET X="LOW HEALTH LITERACY"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9999999.64
SET DIC("DR")=".1///F;.03////"_BJPCC_";.02////F112"
DO FILE^DICN
KILL DIC,X,DIADD,DLAYGO
+14 IF Y=-1
DO MES^XPDUTL("Adding Health Factor "_BJPCX_" failed")
+15 QUIT
GOTHF(VISIT,HF) ;is this hf already attached to this visit?
+1 NEW X,G
+2 SET G=0
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVHF("AD",VISIT,X))
IF X'=+X!(G)
QUIT
IF $DATA(^AUPNVHF(X,0))
IF $$VAL^XBDIQ1(9000010.23,X,.01)=BJPCNEW
SET G=1
+4 QUIT G
ADDHF(VISIT,HF,HFDA) ;add this v health factor to visit
+1 IF '$GET(VISIT)
QUIT
+2 IF '$DATA(^AUPNVSIT(VISIT,0))
QUIT
+3 ;SET UP ARRAY WITH SAME VALUES AS THE OTHER ENTRY
+4 NEW BJPCFDA,BJPCIENS,BJPCERRR,BJPCPIEN,DITC
+5 SET DITC=1
+6 SET BJPCIENS="+1,"
+7 SET BJPCFDA(9000010.23,BJPCIENS,.01)=$ORDER(^AUTTHF("B",HF,0))
+8 SET BJPCFDA(9000010.23,BJPCIENS,.02)=$PIECE(^AUPNVHF(HFDA,0),U,2)
+9 SET BJPCFDA(9000010.23,BJPCIENS,.03)=VISIT
+10 IF $PIECE(^AUPNVHF(HFDA,0),U,4)]""
SET BJPCFDA(9000010.23,BJPCIENS,.04)=$PIECE(^AUPNVHF(HFDA,0),U,4)
+11 IF $PIECE(^AUPNVHF(HFDA,0),U,5)]""
SET BJPCFDA(9000010.23,BJPCIENS,.05)=$PIECE(^AUPNVHF(HFDA,0),U,5)
+12 IF $PIECE(^AUPNVHF(HFDA,0),U,6)]""
SET BJPCFDA(9000010.23,BJPCIENS,.06)=$PIECE(^AUPNVHF(HFDA,0),U,6)
+13 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,1)]""
SET BJPCFDA(9000010.23,BJPCIENS,1201)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,1)
+14 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,2)]""
SET BJPCFDA(9000010.23,BJPCIENS,1202)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,2)
+15 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,3)]""
SET BJPCFDA(9000010.23,BJPCIENS,1203)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,3)
+16 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,4)]""
SET BJPCFDA(9000010.23,BJPCIENS,1204)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,4)
+17 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,8)]""
SET BJPCFDA(9000010.23,BJPCIENS,1208)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,8)
+18 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,9)]""
SET BJPCFDA(9000010.23,BJPCIENS,1209)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,9)
+19 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,10)]""
SET BJPCFDA(9000010.23,BJPCIENS,1210)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,10)
+20 IF $PIECE($GET(^AUPNVHF(HFDA,12)),U,15)]""
SET BJPCFDA(9000010.23,BJPCIENS,1215)=$PIECE($GET(^AUPNVHF(HFDA,12)),U,15)
+21 IF $PIECE($GET(^AUPNVHF(HFDA,801)),U,1)]""
SET BJPCFDA(9000010.23,BJPCIENS,80101)=$PIECE($GET(^AUPNVHF(HFDA,801)),U,1)
+22 IF $PIECE($GET(^AUPNVHF(HFDA,801)),U,2)]""
SET BJPCFDA(9000010.23,BJPCIENS,80102)=$PIECE($GET(^AUPNVHF(HFDA,801)),U,2)
+23 IF $PIECE($GET(^AUPNVHF(HFDA,811)),U,1)]""
SET BJPCFDA(9000010.23,BJPCIENS,81101)=$PIECE($GET(^AUPNVHF(HFDA,811)),U,1)
+24 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,1)]""
SET BJPCFDA(9000010.23,BJPCIENS,81201)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,1)
+25 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,2)]""
SET BJPCFDA(9000010.23,BJPCIENS,81202)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,2)
+26 IF $PIECE($GET(^AUPNVHF(HFDA,812)),U,3)]""
SET BJPCFDA(9000010.23,BJPCIENS,81203)=$PIECE($GET(^AUPNVHF(HFDA,812)),U,1)
+27 DO UPDATE^DIE("","BJPCFDA","BJPCIENS","BJPCERRR(1)")
+28 IF $DATA(BJPCERRR)
DO MES^XPDUTL("Error creating V Health Factor "_HF_" for visit ien "_VISIT_".")
QUIT
+29 WRITE "."
+30 QUIT
+31 ;
LAB ;EP
+1 SET APCSX="SURVEILLANCE RAPID FLU TESTS"
DO LAB1
+2 ;D HLO
+3 QUIT
LAB1 ;
+1 SET APCSDA=$ORDER(^ATXLAB("B",APCSX,0))
+2 ;taxonomy already exisits
IF APCSDA
QUIT
+3 WRITE !,"Creating ",APCSX," Taxonomy..."
+4 SET X=APCSX
SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002228
DO ^DIC
KILL DIC,DA,DIADD,DLAYGO,I
+5 IF Y=-1
WRITE !!,"ERROR IN CREATING ",APCSX," TAX"
QUIT
+6 SET APCSTX=+Y
SET $PIECE(^ATXLAB(APCSTX,0),U,2)=APCSX
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,6)=DT
SET $PIECE(^(0),U,8)="B"
SET $PIECE(^(0),U,9)=60
+7 SET ^ATXLAB(APCSTX,21,0)="^9002228.02101PA^0^0"
+8 SET DA=APCSTX
SET DIK="^ATXAX("
DO IX1^DIK
+9 QUIT
+10 ;
HLO ;--register the app in HLO
+1 NEW FDA,FIENS,FERR,PCCI
+2 IF $ORDER(^HLD(779.2,"B","RPMS-ILI",0))
QUIT
+3 SET PCCI=$ORDER(^DIC(9.4,"B","IHS PCC SUITE",0))
+4 IF 'PCCI
QUIT
+5 SET FIENS=""
+6 SET FDA(779.2,"+1,",.01)="RPMS-ILI"
+7 SET FDA(779.2,"+1,",2)=PCCI
+8 DO UPDATE^DIE("","FDA","FIENS","FERR(1)")
+9 QUIT
INSTALLD(BJPCSTAL) ;EP - Determine if patch BJPCSTAL was installed, where
+1 ; APCLSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW BJPCY,DIC,X,Y
+4 SET X=$PIECE(BJPCSTAL,"*",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(BJPCSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(BJPCSTAL,"*",3)
+12 DO ^DIC
+13 SET BJPCY=Y
+14 DO IMES
+15 QUIT $SELECT(BJPCY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_BJPCSTAL_""" 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
