BQICAEP1 ;VNGT/HS/ALA-Dept of EPI Comm Alert Logic ; 25 May 2011 2:28 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
;
;
CHL(BQDFN,RESULT) ;EP - Chlamydia
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
F TAX="BQI C.TRACH SPECIFIC LOINC","BQI C.TRACH NON-SPECIFIC LOINC","BQI C.TRACH DNA QUANT LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI C.TRACH SPECIFIC TAX","BQI C.TRACH NON-SPECIFIC TAX","BQI C.TRACH DNA QUANT TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
I X D LB(X,CT)
K SEARCH,@TREF
Q
;
HEPB(BQDFN,RESULT) ;EP - Hep B
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
F TAX="BQI HEP B QUAL TEST LOINC","BQI HEP B QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HEP B QUAL TEST TAX","BQI HEP B QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
I X D LB(X,CT)
K SEARCH,@TREF
Q
;
HEPC(BQDFN,RESULT) ;EP - Hepatitis C
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
F TAX="BQI HEP C QUAL TEST LOINC","BQI HEP C QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HEP C QUAL TEST TAX","BQI HEP C QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"=",SEARCH(2)="1"_U_"'<"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
K SEARCH,@TREF
; if neither one found, quit
I 'X K @TREF Q
; check whether other HEP tests are negative
D
. NEW X1,X2
. K @TREF
. S TAX="BQI HEP A TESTS LOINC" D BLD^BQITUTL(TAX,.TREF)
. S TAX="BQI HEP A TESTS TAX" D BLD^BQITUTL(TAX,.TREF,"L")
. S SEARCH(1)="NEG"_U_"=",SEARCH(2)="1"_U_"<"
. S X1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
. K @TREF
. S TAX="BQI HEP B CORE TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
. S TAX="BQI HEP B CORE TESTS TAX" D BLD^BQITUTL(TAX,.TREF,"L")
. S X2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
. I 'X1!('X2) D Q
.. I 'X1,$P(X1,U,2)="No Test" D LB(X,CT) Q
.. I 'X2,$P(X2,U,2)="No Test" D LB(X,CT) Q
. ; if both tests are negative
. I X1!(X2) D LB(X,CT) Q
K @TREF
Q
;
HIV(BQDFN,RESULT) ;EP - HIV
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
F TAX="BQI HIV AB QUAL SCREEN LOINC","BQI HIV QUAL CONFIRM LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV AB QUAL SCREEN TAX","BQI HIV QUAL CONFIRM TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV ID SPEC CONFIRM LOINC","BQI HIV QUAL NUC ACID LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV ID SPEC CONFIRM TAX","BQI HIV QUAL NUC ACID TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV QUAL ANTIGEN LOINC","BQI HIV VIROLOGIC TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV QUAL ANTIGEN TAX","BQI HIV VIROLOGIC TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV AB QUANT SCREEN LOINC","BQI HIV QUANT CONFIRM LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV AB QUANT SCREEN TAX","BQI HIV QUANT CONFIRM TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI HIV QUANT NUC ACID LOINC","BQI HIV QUANT ANTIGEN LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIV QUANT NUC ACID TAX","BQI HIV QUANT ANTIGEN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
I X D LB(X,CT) Q
K @TREF
F TAX="BGP CD4 LOINC CODES","BKMV CD4 ABS LOINC CODES","BGP VIRAL LOAD LOINC CODES" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP CD4 TAX","BKMV CD4 ABS TESTS TAX","BGP HIV VIRAL LOAD TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S X=$$LAB^BQITRUTL(TMFRAME,0,BQDFN,"","","'=","","",.TREF)
I X D LB(X,CT) Q
K @TREF
F TAX="BGP CD4 CPTS","BKMV CD4 ABS CPTS","BGP HIV VIRAL LOAD CPTS" D BLD^BQITUTL(TAX,.TREF)
S X=$$TAX^BQITRUTL(TMFRAME,"",1,BQDFN,9000010.18,0,1,.TREF,"","")
I X D
. S $P(X,U,6)=$P(^AUPNVCPT($P(X,U,5),0),U,1)
. D LB(X,CT)
K @TREF
Q
;
DRGP(BQDFN,RESULT) ;EP -
NEW UID,TREF,TAX,DX,LX1,LX2
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S DX=$$TAX^BQITRUTL(TMFRAME,"BQI PNEUMOCOCCAL DXS",1,BQDFN,9000010.07,"","",.TREF)
;
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
S TAX="BQI S PNEUM CULTURE TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM CULTURE TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"="
S LX1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
K @TREF
S TAX="BQI S PNEUM SUSCEPT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM SUSCEPT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S LX2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
;
I LX1,LX2 D
. D LB(LX1,CT) S CT=CT+1 D LB(LX2,CT)
. I DX D DXF^BQICAEP2(DX)
K @TREF,SEARCH
Q
;
INVP(BQDFN,RESULT) ; EP -
NEW UID,TREF,TAX,DX,LX1,LX2
K RESULT
S RESULT(1)=0,CT=1
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DX=$$TAX^BQITRUTL(TMFRAME,"BQI PNEUMOCOCCAL DXS",1,BQDFN,9000010.07,"","",.TREF)
;
S TREF=$NA(^TMP(UID,"BQITAX")) K @TREF
S TAX="BQI S PNEUM CULTURE TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM CULTURE TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"="
S LX1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
K @TREF
S TAX="BQI S PNEUM SUSCEPT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
S TAX="BQI S PNEUM SUSCEPT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="NEG"_U_"="
S LX2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
;
I LX1,LX2 D
. D LB(LX1,CT) S CT=CT+1 D LB(LX2,CT)
. I DX D DXF^BQICAEP2(DX)
K @TREF
Q
;
LB(LX,CT) ;EP
NEW LDATE
S RESULT(CT)=LX
S LDATE=$P(RESULT(CT),U,2),$P(RESULT(CT),U,2)=$$DATE^BQIUL1(LDATE)
K @TREF
Q
BQICAEP1 ;VNGT/HS/ALA-Dept of EPI Comm Alert Logic ; 25 May 2011 2:28 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1**;May 24, 2016;Build 17
+2 ;
+3 ;
CHL(BQDFN,RESULT) ;EP - Chlamydia
+1 NEW UID,TREF,TAX,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 KILL RESULT
+4 SET RESULT(1)=0
SET CT=1
+5 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+6 FOR TAX="BQI C.TRACH SPECIFIC LOINC","BQI C.TRACH NON-SPECIFIC LOINC","BQI C.TRACH DNA QUANT LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI C.TRACH SPECIFIC TAX","BQI C.TRACH NON-SPECIFIC TAX","BQI C.TRACH DNA QUANT TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+9 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+10 IF X
DO LB(X,CT)
+11 KILL SEARCH,@TREF
+12 QUIT
+13 ;
HEPB(BQDFN,RESULT) ;EP - Hep B
+1 NEW UID,TREF,TAX,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 KILL RESULT
+4 SET RESULT(1)=0
SET CT=1
+5 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+6 FOR TAX="BQI HEP B QUAL TEST LOINC","BQI HEP B QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI HEP B QUAL TEST TAX","BQI HEP B QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+9 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+10 IF X
DO LB(X,CT)
+11 KILL SEARCH,@TREF
+12 QUIT
+13 ;
HEPC(BQDFN,RESULT) ;EP - Hepatitis C
+1 NEW UID,TREF,TAX,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 KILL RESULT
+4 SET RESULT(1)=0
SET CT=1
+5 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+6 FOR TAX="BQI HEP C QUAL TEST LOINC","BQI HEP C QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI HEP C QUAL TEST TAX","BQI HEP C QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="1"_U_"'<"
+9 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+10 KILL SEARCH,@TREF
+11 ; if neither one found, quit
+12 IF 'X
KILL @TREF
QUIT
+13 ; check whether other HEP tests are negative
+14 Begin DoDot:1
+15 NEW X1,X2
+16 KILL @TREF
+17 SET TAX="BQI HEP A TESTS LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+18 SET TAX="BQI HEP A TESTS TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+19 SET SEARCH(1)="NEG"_U_"="
SET SEARCH(2)="1"_U_"<"
+20 SET X1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+21 KILL @TREF
+22 SET TAX="BQI HEP B CORE TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+23 SET TAX="BQI HEP B CORE TESTS TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+24 SET X2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+25 IF 'X1!('X2)
Begin DoDot:2
+26 IF 'X1
IF $PIECE(X1,U,2)="No Test"
DO LB(X,CT)
QUIT
+27 IF 'X2
IF $PIECE(X2,U,2)="No Test"
DO LB(X,CT)
QUIT
End DoDot:2
QUIT
+28 ; if both tests are negative
+29 IF X1!(X2)
DO LB(X,CT)
QUIT
End DoDot:1
+30 KILL @TREF
+31 QUIT
+32 ;
HIV(BQDFN,RESULT) ;EP - HIV
+1 NEW UID,TREF,TAX,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 KILL RESULT
+4 SET RESULT(1)=0
SET CT=1
+5 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+6 FOR TAX="BQI HIV AB QUAL SCREEN LOINC","BQI HIV QUAL CONFIRM LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI HIV AB QUAL SCREEN TAX","BQI HIV QUAL CONFIRM TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 FOR TAX="BQI HIV ID SPEC CONFIRM LOINC","BQI HIV QUAL NUC ACID LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+9 FOR TAX="BQI HIV ID SPEC CONFIRM TAX","BQI HIV QUAL NUC ACID TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+10 FOR TAX="BQI HIV QUAL ANTIGEN LOINC","BQI HIV VIROLOGIC TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+11 FOR TAX="BQI HIV QUAL ANTIGEN TAX","BQI HIV VIROLOGIC TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+12 FOR TAX="BQI HIV AB QUANT SCREEN LOINC","BQI HIV QUANT CONFIRM LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+13 FOR TAX="BQI HIV AB QUANT SCREEN TAX","BQI HIV QUANT CONFIRM TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+14 FOR TAX="BQI HIV QUANT NUC ACID LOINC","BQI HIV QUANT ANTIGEN LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+15 FOR TAX="BQI HIV QUANT NUC ACID TAX","BQI HIV QUANT ANTIGEN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+16 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+17 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+18 IF X
DO LB(X,CT)
QUIT
+19 KILL @TREF
+20 FOR TAX="BGP CD4 LOINC CODES","BKMV CD4 ABS LOINC CODES","BGP VIRAL LOAD LOINC CODES"
DO BLD^BQITUTL(TAX,.TREF)
+21 FOR TAX="BGP CD4 TAX","BKMV CD4 ABS TESTS TAX","BGP HIV VIRAL LOAD TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+22 SET X=$$LAB^BQITRUTL(TMFRAME,0,BQDFN,"","","'=","","",.TREF)
+23 IF X
DO LB(X,CT)
QUIT
+24 KILL @TREF
+25 FOR TAX="BGP CD4 CPTS","BKMV CD4 ABS CPTS","BGP HIV VIRAL LOAD CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+26 SET X=$$TAX^BQITRUTL(TMFRAME,"",1,BQDFN,9000010.18,0,1,.TREF,"","")
+27 IF X
Begin DoDot:1
+28 SET $PIECE(X,U,6)=$PIECE(^AUPNVCPT($PIECE(X,U,5),0),U,1)
+29 DO LB(X,CT)
End DoDot:1
+30 KILL @TREF
+31 QUIT
+32 ;
DRGP(BQDFN,RESULT) ;EP -
+1 NEW UID,TREF,TAX,DX,LX1,LX2
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 KILL RESULT
+4 SET RESULT(1)=0
SET CT=1
+5 SET DX=$$TAX^BQITRUTL(TMFRAME,"BQI PNEUMOCOCCAL DXS",1,BQDFN,9000010.07,"","",.TREF)
+6 ;
+7 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+8 SET TAX="BQI S PNEUM CULTURE TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+9 SET TAX="BQI S PNEUM CULTURE TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+10 SET SEARCH(1)="POS"_U_"="
+11 SET LX1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+12 KILL @TREF
+13 SET TAX="BQI S PNEUM SUSCEPT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+14 SET TAX="BQI S PNEUM SUSCEPT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+15 SET LX2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+16 ;
+17 IF LX1
IF LX2
Begin DoDot:1
+18 DO LB(LX1,CT)
SET CT=CT+1
DO LB(LX2,CT)
+19 IF DX
DO DXF^BQICAEP2(DX)
End DoDot:1
+20 KILL @TREF,SEARCH
+21 QUIT
+22 ;
INVP(BQDFN,RESULT) ; EP -
+1 NEW UID,TREF,TAX,DX,LX1,LX2
+2 KILL RESULT
+3 SET RESULT(1)=0
SET CT=1
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DX=$$TAX^BQITRUTL(TMFRAME,"BQI PNEUMOCOCCAL DXS",1,BQDFN,9000010.07,"","",.TREF)
+6 ;
+7 SET TREF=$NAME(^TMP(UID,"BQITAX"))
KILL @TREF
+8 SET TAX="BQI S PNEUM CULTURE TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+9 SET TAX="BQI S PNEUM CULTURE TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+10 SET SEARCH(1)="POS"_U_"="
+11 SET LX1=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+12 KILL @TREF
+13 SET TAX="BQI S PNEUM SUSCEPT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+14 SET TAX="BQI S PNEUM SUSCEPT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+15 SET SEARCH(1)="NEG"_U_"="
+16 SET LX2=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+17 ;
+18 IF LX1
IF LX2
Begin DoDot:1
+19 DO LB(LX1,CT)
SET CT=CT+1
DO LB(LX2,CT)
+20 IF DX
DO DXF^BQICAEP2(DX)
End DoDot:1
+21 KILL @TREF
+22 QUIT
+23 ;
LB(LX,CT) ;EP
+1 NEW LDATE
+2 SET RESULT(CT)=LX
+3 SET LDATE=$PIECE(RESULT(CT),U,2)
SET $PIECE(RESULT(CT),U,2)=$$DATE^BQIUL1(LDATE)
+4 KILL @TREF
+5 QUIT
