BQI23P2 ;GDIT/HS/ALA-Patch 2 Installation ; 28 Dec 2012 8:13 AM
;;2.3;ICARE MANAGEMENT SYSTEM;**2**;Apr 18, 2012;Build 14
;
PRE ;EP
NEW DA,DIK
S DA=0,DIK="^BQI(90509.9,"
F S DA=$O(^BQI(90509.9,DA)) Q:'DA D ^DIK
Q
;
POS ;EP
;
; Fix Goal Setting
NEW TPRN,TPRD,GPRN,GPRD,DEN,FAC,YEAR,BQDATE
S YEAR=$$GET1^DIQ(90508,1_",",2,"E")
S FAC=$$HME^BQIGPUTL()
S TPRN=$O(^BQIFAC(FAC,30,"B","IPC_TOTP",""))
S GPRN=$O(^BQIFAC(FAC,30,"B",YEAR_"_2452",""))
I GPRN'="",TPRN'="" D
. S BQDATE=""
. F S BQDATE=$O(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE)) Q:BQDATE="" D
.. S TPRD=$O(^BQIFAC(FAC,30,TPRN,1,"B",BQDATE,"")) I TPRD="" Q
.. S GPRD=$O(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE,"")) I GPRD="" Q
.. S DEN=$P(^BQIFAC(FAC,30,TPRN,1,TPRD,0),U,2)
.. S $P(^BQIFAC(FAC,30,GPRN,1,GPRD,0),U,2)=DEN
;
; fix A1C
I $P($G(^BQI(90508,1,"GPRA")),U,1)=2012 D
. S ^BQI(90508,1,22,2,1,15,2,1,0)="2012_2633"
. K ^BQI(90508,1,22,2,1,15,2,"B")
. S ^BQI(90508,1,22,2,1,15,2,"B","2012_2633",1)=""
I $P($G(^BQI(90508,1,"GPRA")),U,1)=2013 D
. S ^BQI(90508,1,22,2,1,15,2,1,0)="2013_2633"
. K ^BQI(90508,1,22,2,1,15,2,"B")
. S ^BQI(90508,1,22,2,1,15,2,"B","2013_2633",1)=""
S $P(^BQI(90508,1,22,2,1,16,0),U,4)="Alcohol Screen Females 15-44"
;
NEW TAX,DIK,DA
F TAX="BQI SYPH DARK FIELD TEST LOINC","BQI SYPHILIS QUAL TEST LOINC","BQI SYPHILIS QUANT TEST LOINC" D
. S DIK="^ATXAX(",DA=$O(^ATXAX("B",TAX,"")) I DA'="" D ^DIK
F TAX="BQI SYPH DARK FIELD TEST TAX","BQI SYPHILIS QUAL TEST TAX","BQI SYPHILIS QUANT TEST TAX" D
. S DIK="^ATXLAB(",DA=$O(^ATXLAB("B",TAX,"")) I DA'="" D ^DIK
;
LTAX ;EP Add Lab Taxonomies to ^ATXLAB
NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM
S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
; Loop through the Taxonomies
D LDLAB(.LTAX)
F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
. I $D(^ATXLAB("B",X)) Q ; Skip pre-existing Lab taxonomies
. D ^DIC S DA=+Y
. I DA<1 Q
. S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
. S BQTXUP(9002228,DA_",",.05)=DUZ
. S BQTXUP(9002228,DA_",",.06)=DT
. S BQTXUP(9002228,DA_",",.09)=60
. D FILE^DIE("I","BQTXUP")
. S BQTXUP(9002228,DA_",",.08)="B"
. D FILE^DIE("E","BQTXUP")
;
K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
;
TAX ;EP Set up the taxonomies
D ^BQIHTX
;
; Remove LOINC code
NEW TXN
S TXN=$O(^ATXAX("B","BQI HIV ID SPEC CONFIRM LOINC",""))
I TXN'="" D
. NEW DA,DIK
. S DA=$O(^ATXAX(TXN,21,"B","13499-9","")) I DA="" Q
. S DA(1)=TXN,DIK="^ATXAX("_DA(1)_",21," D ^DIK
;
GLS ;EP Update glossary
NEW GN,GNM,GSN,BQIUPD
S GN=0
F S GN=$O(^BQI(90509.9,GN)) Q:'GN D
. S GNM=$P(^BQI(90509.9,GN,0),U,1)
. S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""
. S BQIUPD(90508.2,GSN_",",1)="@"
. D FILE^DIE("","BQIUPD","ERROR")
. M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
Q
;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
NEW I,TEXT
F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT="" S ARRAY(I)=TEXT
Q
;
LAB ;EP;LAB TESTS (SITE-POPULATED)
;;BQI SYPHILIS TP-AB TEST TAX
;;BQI SYPHILIS REAGIN TEST TAX
Q
BQI23P2 ;GDIT/HS/ALA-Patch 2 Installation ; 28 Dec 2012 8:13 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**2**;Apr 18, 2012;Build 14
+2 ;
PRE ;EP
+1 NEW DA,DIK
+2 SET DA=0
SET DIK="^BQI(90509.9,"
+3 FOR
SET DA=$ORDER(^BQI(90509.9,DA))
IF 'DA
QUIT
DO ^DIK
+4 QUIT
+5 ;
POS ;EP
+1 ;
+2 ; Fix Goal Setting
+3 NEW TPRN,TPRD,GPRN,GPRD,DEN,FAC,YEAR,BQDATE
+4 SET YEAR=$$GET1^DIQ(90508,1_",",2,"E")
+5 SET FAC=$$HME^BQIGPUTL()
+6 SET TPRN=$ORDER(^BQIFAC(FAC,30,"B","IPC_TOTP",""))
+7 SET GPRN=$ORDER(^BQIFAC(FAC,30,"B",YEAR_"_2452",""))
+8 IF GPRN'=""
IF TPRN'=""
Begin DoDot:1
+9 SET BQDATE=""
+10 FOR
SET BQDATE=$ORDER(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE))
IF BQDATE=""
QUIT
Begin DoDot:2
+11 SET TPRD=$ORDER(^BQIFAC(FAC,30,TPRN,1,"B",BQDATE,""))
IF TPRD=""
QUIT
+12 SET GPRD=$ORDER(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE,""))
IF GPRD=""
QUIT
+13 SET DEN=$PIECE(^BQIFAC(FAC,30,TPRN,1,TPRD,0),U,2)
+14 SET $PIECE(^BQIFAC(FAC,30,GPRN,1,GPRD,0),U,2)=DEN
End DoDot:2
End DoDot:1
+15 ;
+16 ; fix A1C
+17 IF $PIECE($GET(^BQI(90508,1,"GPRA")),U,1)=2012
Begin DoDot:1
+18 SET ^BQI(90508,1,22,2,1,15,2,1,0)="2012_2633"
+19 KILL ^BQI(90508,1,22,2,1,15,2,"B")
+20 SET ^BQI(90508,1,22,2,1,15,2,"B","2012_2633",1)=""
End DoDot:1
+21 IF $PIECE($GET(^BQI(90508,1,"GPRA")),U,1)=2013
Begin DoDot:1
+22 SET ^BQI(90508,1,22,2,1,15,2,1,0)="2013_2633"
+23 KILL ^BQI(90508,1,22,2,1,15,2,"B")
+24 SET ^BQI(90508,1,22,2,1,15,2,"B","2013_2633",1)=""
End DoDot:1
+25 SET $PIECE(^BQI(90508,1,22,2,1,16,0),U,4)="Alcohol Screen Females 15-44"
+26 ;
+27 NEW TAX,DIK,DA
+28 FOR TAX="BQI SYPH DARK FIELD TEST LOINC","BQI SYPHILIS QUAL TEST LOINC","BQI SYPHILIS QUANT TEST LOINC"
Begin DoDot:1
+29 SET DIK="^ATXAX("
SET DA=$ORDER(^ATXAX("B",TAX,""))
IF DA'=""
DO ^DIK
End DoDot:1
+30 FOR TAX="BQI SYPH DARK FIELD TEST TAX","BQI SYPHILIS QUAL TEST TAX","BQI SYPHILIS QUANT TEST TAX"
Begin DoDot:1
+31 SET DIK="^ATXLAB("
SET DA=$ORDER(^ATXLAB("B",TAX,""))
IF DA'=""
DO ^DIK
End DoDot:1
+32 ;
LTAX ;EP Add Lab Taxonomies to ^ATXLAB
+1 NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM
+2 SET DIC="^ATXLAB("
SET DIC(0)="L"
SET DLAYGO=9002228
+3 ; Loop through the Taxonomies
+4 DO LDLAB(.LTAX)
+5 FOR BJ=1:1
IF '$DATA(LTAX(BJ))
QUIT
SET X=LTAX(BJ)
Begin DoDot:1
+6 ; Skip pre-existing Lab taxonomies
IF $DATA(^ATXLAB("B",X))
QUIT
+7 DO ^DIC
SET DA=+Y
+8 IF DA<1
QUIT
+9 SET BQTXUP(9002228,DA_",",.02)=$PIECE(X," ",2,999)
+10 SET BQTXUP(9002228,DA_",",.05)=DUZ
+11 SET BQTXUP(9002228,DA_",",.06)=DT
+12 SET BQTXUP(9002228,DA_",",.09)=60
+13 DO FILE^DIE("I","BQTXUP")
+14 SET BQTXUP(9002228,DA_",",.08)="B"
+15 DO FILE^DIE("E","BQTXUP")
End DoDot:1
+16 ;
+17 KILL DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
+18 ;
TAX ;EP Set up the taxonomies
+1 DO ^BQIHTX
+2 ;
+3 ; Remove LOINC code
+4 NEW TXN
+5 SET TXN=$ORDER(^ATXAX("B","BQI HIV ID SPEC CONFIRM LOINC",""))
+6 IF TXN'=""
Begin DoDot:1
+7 NEW DA,DIK
+8 SET DA=$ORDER(^ATXAX(TXN,21,"B","13499-9",""))
IF DA=""
QUIT
+9 SET DA(1)=TXN
SET DIK="^ATXAX("_DA(1)_",21,"
DO ^DIK
End DoDot:1
+10 ;
GLS ;EP Update glossary
+1 NEW GN,GNM,GSN,BQIUPD
+2 SET GN=0
+3 FOR
SET GN=$ORDER(^BQI(90509.9,GN))
IF 'GN
QUIT
Begin DoDot:1
+4 SET GNM=$PIECE(^BQI(90509.9,GN,0),U,1)
+5 SET GSN=$ORDER(^BQI(90508.2,"B",GNM,""))
IF GSN=""
QUIT
+6 SET BQIUPD(90508.2,GSN_",",1)="@"
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 MERGE ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
End DoDot:1
+9 QUIT
+10 ;
LDLAB(ARRAY) ;EP;Load site-populated Lab tests
+1 NEW I,TEXT
+2 FOR I=1:1
SET TEXT=$PIECE($TEXT(LAB+I),";;",2)
IF TEXT=""
QUIT
SET ARRAY(I)=TEXT
+3 QUIT
+4 ;
LAB ;EP;LAB TESTS (SITE-POPULATED)
+1 ;;BQI SYPHILIS TP-AB TEST TAX
+2 ;;BQI SYPHILIS REAGIN TEST TAX
+3 QUIT
