BQICAEP2 ;GDIT/HS/ALA-Dept of EPI Comm Alert Logic ; 03 Oct 2011 12:26 PM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
;
MEAS(BQDFN,RESULT) ;EP - Measles
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("BQITAX",$J)) K @TREF
F TAX="BQI MEASLES ALERT LOINCS" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MEASLES ALERT TAX" D BLD^BQITUTL(TAX,.TREF,"L")
S SEARCH(1)="POS"_U_"=",SEARCH(2)="1.09"_U_">"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
I X D LB^BQICAEP1(X,CT)
K SEARCH,@TREF
Q
;
MEN(BQDFN,RESULT) ;EP - Meningitis
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("BQITAX",$J)) K @TREF
F TAX="BQI MENINGITIS QUAL TEST LOINC","BQI MENINGITIS ID SPEC LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MENINGITIS GRAM STAIN LNC","BQI MENINGITIS QUAN LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI MENINGITIS QUAL TEST TAX","BQI MENINGITIS GRAM STAIN TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI MENINGITIS ID SPEC TAX","BQI MENINGITIS QUAN 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^BQICAEP1(X,CT)
K SEARCH,@TREF
Q
;
FLU(BQDFN,RESULT) ;EP - Influenza
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S SEARCH(1)="POS"_U_"="
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
S TAX="SURVEILLANCE RAPID FLU TESTS" D BLD^BQITUTL(TAX,.TREF,"L")
S TAX="SURVEILLANCE RAPID FLU LOINC" D BLD^BQITUTL(TAX,.TREF)
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
I X D LB^BQICAEP1(X,CT)
K SEARCH,@TREF
Q
;
FLUD(BQDFN,RESULT) ;EP - Flu Diagnosis
NEW UID,TREF,TAX,X
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;S TIME="T-14M"
S X=$$TAX^BQITRUTL(TMFRAME,"BQI ILI NO TMP NEEDED DXS",1,BQDFN,9000010.07,"","",.TREF)
I X D DXF(X) K @TREF Q
;
S X=$$TAX^BQITRUTL(TMFRAME,"SURVEILLANCE ILI",1,BQDFN,9000010.07,"","",.TREF)
I 'X Q
S VISIT=$P(X,U,4)
S X1=$$MEAS^BQICAUTL(BQDFN,"TMP",VISIT,"100",">") I 'X1 Q
D DXF(X),MSF(X1)
K @TREF
Q
;
TUB(BQDFN,RESULT) ; EP - Tuberculosis
NEW UID,TREF,TAX,X,BDX,BX
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
S BDXX=$$TAX^BQITRUTL(TMFRAME,"BQI TUBERCULOSIS DXS",1,BQDFN,9000010.07,"","",.TREF)
I BDXX D DXF(BDXX)
K @TREF
;
; Check for positive skin test
S BSXX=$$SKTST(BQDFN,"T-60")
I BSXX D
. NEW VSDTM,TIEN,VISIT,IEN
. S VSDTM=$P(BSXX,U,2),VISIT=$P(BSXX,U,4),IEN=$P(BSXX,U,5),TIEN=$P(^AUPNVSK(IEN,0),U,1)
. S @DATA@(COMM,ALRT,BQDFN,"SK",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.12"
;
; Check for BCG or other immunization
S BX=$$BCG(BQDFN,"")
;
F TAX="BKM PPD LOINC CODES","BQI PPD DIAMETER LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BKM PPD TAX","BQI PPD DIAMETER TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB GAMMA REL QUAL TEST TAX","BQI TB GAMMA REL QUANT TEST TX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB GAMMA REL QUAL TEST LNC","BQI TB GAMMA REL QUANT TEST LC" D BLD^BQITUTL(TAX,.TREF)
S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
S X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
K SEARCH,@TREF
I X!(BSXX),'BX,BDXX D LB^BQICAEP1(X,CT) Q
;
K @TREF
F TAX="BQI TB RNA DNA QUAL TEST LOINC","BQI TB RNA DNA QUANT TEST LNC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI TB RNA DNA QUAL TEST TAX","BQI TB RNA DNA QUANT TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
F TAX="BQI TB SPECIFIC AFB TEST LOINC","BQI TB NONSPEC AFB TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI TB SPECIFIC AFB TEST TAX","BQI TB NONSPEC AFB 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,'BX,BDXX D LB^BQICAEP1(X,CT)
K SEARCH,@TREF
Q
;
SYP(BQDFN,RESULT) ;EP - Syphilis
NEW UID,TREF,TAX,XTP,XSC,DATE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
K RESULT
S RESULT(1)=0,CT=1
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
;
D
. S TAX="BQI SYPHILIS TP-AB LOINC" D BLD^BQITUTL(TAX,.TREF)
. S TAX="BQI SYPHILIS TP-AB TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
. S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">"
. S XTP=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
. K @TREF
. S TAX="BQI SYPHILIS REAGIN LOINC" D BLD^BQITUTL(TAX,.TREF)
. S TAX="BQI SYPHILIS REAGIN TEST TAX" D BLD^BQITUTL(TAX,.TREF,"L")
. S SEARCH(1)="POS"_U_"=",SEARCH(2)="0"_U_">",DATE=$P(XTP,U,2)
. S XSC=$$LBB^BQICAUTL(30,0,DATE,BQDFN,"",.SEARCH,.TREF)
. K @TREF
. I 'XTP,'XSC Q
. I XSC D
.. NEW XBGS,XBES
.. S XBGS=$P(XSC,U,2),XBES=DT
.. S XFPS=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGS,XBES)
.. I XFPS S XSC=0
. I XTP D
.. S XBGT=$P(XTP,U,2),XBET=DT
.. S XFPT=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGT,XBET)
.. I XFPT S XTP=0
;
I XTP,XSC D
. D LB^BQICAEP1(XTP,CT) S CT=CT+1
. D LB^BQICAEP1(XSC,CT)
K SEARCH,@TREF
Q
;
HIB(BQDFN,RESULT) ;EP - HIB Flu
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("BQITAX",$J)) K @TREF
F TAX="BQI HIB QUAL TEST LOINC","BQI HIB CULTURE TEST LOINC","BQI HIB QUANT TEST LOINC" D BLD^BQITUTL(TAX,.TREF)
F TAX="BQI HIB QUAL TEST TAX","BQI HIB CULTURE TEST TAX","BQI HIB 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^BQICAEP1(X,CT)
K SEARCH,@TREF
Q
;
DXF(BQX) ;EP - Diagnosis
NEW VSDTM,TIEN,VISIT,IEN
S VSDTM=$P(BQX,U,2),VISIT=$P(BQX,U,4),IEN=$P(BQX,U,5),TIEN=$P(^AUPNVPOV(IEN,0),U,1)
S @DATA@(COMM,ALRT,BQDFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
Q
;
MSF(BQX) ;EP - Measurement
NEW VSDTM,TIEN,VISIT,IEN
S VSDTM=$P(BQX,U,2),VISIT=$P(BQX,U,4),IEN=$P(BQX,U,5),TIEN=$P(^AUPNVMSR(IEN,0),U,1)
S @DATA@(COMM,ALRT,BQDFN,"MS",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.01"
Q
;
BCG(BQDFN,TMFRAME) ;EP - BCG Vaccination
; immunization BCG or 19
; cpt codes 90728 or 90585
; icd9 diagnosis V03.2
; icd9 procedure 99.33
;
NEW ENDT,STDT,BGDT,BQIM,QFL,IEN,VIEN,TIEN,RES,TREF,BPOV
S RES=0
I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
I $G(TMFRAME)="" S STDT="",ENDT=""
;
; Check BCG immunization
S BQIM=$O(^AUTTIMM("B","BCG","")) I BQIM'="" D
. S QFL=0 I ENDT="" S ENDT=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT),-1)
. F S STDT=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT)) Q:STDT=""!(STDT>ENDT) D Q:QFL
.. S IEN=""
.. F S IEN=$O(^AUPNVIMM("AA",BQDFN,BQIM,STDT,IEN)) Q:IEN="" D Q:QFL
... S VIEN=$P($G(^AUPNVIMM(IEN,0)),U,3)
... S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
;
I RES Q RES
; check for ICD9 diagnosis
S TREF="BQILST" K @TREF
D BLDSV^BQITUTL(80,"V03.2 ",TREF)
I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
I $G(TMFRAME)="" S STDT="",ENDT=""
I ENDT="" S ENDT=$O(^AUPNVPOV("AA",BQDFN,""),-1)
F S STDT=$O(^AUPNVPOV("AA",BQDFN,STDT)) Q:STDT=""!(STDT>ENDT) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVPOV("AA",BQDFN,STDT,IEN)) Q:IEN="" D Q:QFL
.. S BPOV=$P($G(^AUPNVPOV(IEN,0)),U,1) I BPOV="" Q
.. I '$D(@TREF@(BPOV)) Q
.. S VIEN=$P(^AUPNVPOV(IEN,0),U,3)
.. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
;
I RES Q RES
;
; Check for CPT codes
S TREF="BQILST" K @TREF
D BLDSV^BQITUTL(81,"90585 ",TREF),BLDSV^BQITUTL(81,"90728 ",TREF)
S TIEN="",QFL=0
F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D Q:QFL
. I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
. I $G(TMFRAME)="" S STDT="",ENDT=""
. I ENDT="" S ENDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,""),-1)
. F S STDT=$O(^AUPNVCPT("AA",BQDFN,TIEN,STDT)) Q:STDT=""!(STDT>ENDT) D Q:QFL
.. S IEN=""
.. F S IEN=$O(^AUPNVCPT("AA",BQDFN,TIEN,STDT,IEN)) Q:IEN="" D Q:QFL
... S VIEN=$P($G(^AUPNVCPT(IEN,0)),U,3)
... S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
;
I RES Q RES
;
; Check for procedure
S TREF="BQILST" K @TREF
D BLDSV^BQITUTL(80.1,"99.33 ",TREF)
I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
I $G(TMFRAME)="" S STDT="",ENDT=""
I ENDT="" S ENDT=$O(^AUPNVPRC("AA",BQDFN,""),-1)
F S STDT=$O(^AUPNVPRC("AA",BQDFN,STDT)) Q:STDT=""!(STDT>ENDT) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVPRC("AA",BQDFN,STDT,IEN)) Q:IEN="" D Q:QFL
.. S BPOV=$P($G(^AUPNVPRC(IEN,0)),U,1) I BPOV="" Q
.. I '$D(@TREF@(BPOV)) Q
.. S VIEN=$P(^AUPNVPRC(IEN,0),U,3)
.. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
K @TREF
Q RES
;
SKTST(BQDFN,TMFRAME) ;EP - Skin Test
NEW SKN,ENDT,STDT,BGDT,IEN,VIEN,RES,VALUE
S SKN=$$FIND1^DIC(9999999.28,,"X","PPD")
S RES=0
I $G(TMFRAME)'="" S ENDT=(9999999-$$DATE^BQIUL1(TMFRAME)),BGDT=9999999-DT,STDT=ENDT-.0001
I $G(TMFRAME)="" S STDT="",ENDT=""
I ENDT="" S ENDT=$O(^AUPNVSK("AA",BQDFN,SKN,""),-1)
F S STDT=$O(^AUPNVSK("AA",BQDFN,SKN,STDT)) Q:STDT=""!(STDT>ENDT) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVSK("AA",BQDFN,SKN,STDT,IEN)) Q:IEN="" D Q:QFL
.. S VIEN=$P($G(^AUPNVSK(IEN,0)),U,3) I VIEN="" Q
.. ; If the reading is greater than 15 mm, then it is positive
.. S VALUE=+$P(^AUPNVSK(IEN,0),U,5)'>15 Q
.. S RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U_"9000010.12"
Q RES
BQICAEP2 ;GDIT/HS/ALA-Dept of EPI Comm Alert Logic ; 03 Oct 2011 12:26 PM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 ;
MEAS(BQDFN,RESULT) ;EP - Measles
+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("BQITAX",$JOB))
KILL @TREF
+6 FOR TAX="BQI MEASLES ALERT LOINCS"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI MEASLES ALERT TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="1.09"_U_">"
+9 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+10 IF X
DO LB^BQICAEP1(X,CT)
+11 KILL SEARCH,@TREF
+12 QUIT
+13 ;
MEN(BQDFN,RESULT) ;EP - Meningitis
+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("BQITAX",$JOB))
KILL @TREF
+6 FOR TAX="BQI MENINGITIS QUAL TEST LOINC","BQI MENINGITIS ID SPEC LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI MENINGITIS GRAM STAIN LNC","BQI MENINGITIS QUAN LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+8 FOR TAX="BQI MENINGITIS QUAL TEST TAX","BQI MENINGITIS GRAM STAIN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+9 FOR TAX="BQI MENINGITIS ID SPEC TAX","BQI MENINGITIS QUAN TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+10 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+11 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+12 IF X
DO LB^BQICAEP1(X,CT)
+13 KILL SEARCH,@TREF
+14 QUIT
+15 ;
FLU(BQDFN,RESULT) ;EP - Influenza
+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 SEARCH(1)="POS"_U_"="
+6 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+7 SET TAX="SURVEILLANCE RAPID FLU TESTS"
DO BLD^BQITUTL(TAX,.TREF,"L")
+8 SET TAX="SURVEILLANCE RAPID FLU LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+9 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+10 IF X
DO LB^BQICAEP1(X,CT)
+11 KILL SEARCH,@TREF
+12 QUIT
+13 ;
FLUD(BQDFN,RESULT) ;EP - Flu Diagnosis
+1 NEW UID,TREF,TAX,X
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 ;S TIME="T-14M"
+4 SET X=$$TAX^BQITRUTL(TMFRAME,"BQI ILI NO TMP NEEDED DXS",1,BQDFN,9000010.07,"","",.TREF)
+5 IF X
DO DXF(X)
KILL @TREF
QUIT
+6 ;
+7 SET X=$$TAX^BQITRUTL(TMFRAME,"SURVEILLANCE ILI",1,BQDFN,9000010.07,"","",.TREF)
+8 IF 'X
QUIT
+9 SET VISIT=$PIECE(X,U,4)
+10 SET X1=$$MEAS^BQICAUTL(BQDFN,"TMP",VISIT,"100",">")
IF 'X1
QUIT
+11 DO DXF(X)
DO MSF(X1)
+12 KILL @TREF
+13 QUIT
+14 ;
TUB(BQDFN,RESULT) ; EP - Tuberculosis
+1 NEW UID,TREF,TAX,X,BDX,BX
+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("BQITAX",$JOB))
KILL @TREF
+6 SET BDXX=$$TAX^BQITRUTL(TMFRAME,"BQI TUBERCULOSIS DXS",1,BQDFN,9000010.07,"","",.TREF)
+7 IF BDXX
DO DXF(BDXX)
+8 KILL @TREF
+9 ;
+10 ; Check for positive skin test
+11 SET BSXX=$$SKTST(BQDFN,"T-60")
+12 IF BSXX
Begin DoDot:1
+13 NEW VSDTM,TIEN,VISIT,IEN
+14 SET VSDTM=$PIECE(BSXX,U,2)
SET VISIT=$PIECE(BSXX,U,4)
SET IEN=$PIECE(BSXX,U,5)
SET TIEN=$PIECE(^AUPNVSK(IEN,0),U,1)
+15 SET @DATA@(COMM,ALRT,BQDFN,"SK",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.12"
End DoDot:1
+16 ;
+17 ; Check for BCG or other immunization
+18 SET BX=$$BCG(BQDFN,"")
+19 ;
+20 FOR TAX="BKM PPD LOINC CODES","BQI PPD DIAMETER LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+21 FOR TAX="BKM PPD TAX","BQI PPD DIAMETER TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+22 FOR TAX="BQI TB GAMMA REL QUAL TEST TAX","BQI TB GAMMA REL QUANT TEST TX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+23 FOR TAX="BQI TB GAMMA REL QUAL TEST LNC","BQI TB GAMMA REL QUANT TEST LC"
DO BLD^BQITUTL(TAX,.TREF)
+24 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+25 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+26 KILL SEARCH,@TREF
+27 IF X!(BSXX)
IF 'BX
IF BDXX
DO LB^BQICAEP1(X,CT)
QUIT
+28 ;
+29 KILL @TREF
+30 FOR TAX="BQI TB RNA DNA QUAL TEST LOINC","BQI TB RNA DNA QUANT TEST LNC"
DO BLD^BQITUTL(TAX,.TREF)
+31 FOR TAX="BQI TB RNA DNA QUAL TEST TAX","BQI TB RNA DNA QUANT TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+32 FOR TAX="BQI TB SPECIFIC AFB TEST LOINC","BQI TB NONSPEC AFB TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+33 FOR TAX="BQI TB SPECIFIC AFB TEST TAX","BQI TB NONSPEC AFB TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+34 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+35 SET X=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+36 IF X
IF 'BX
IF BDXX
DO LB^BQICAEP1(X,CT)
+37 KILL SEARCH,@TREF
+38 QUIT
+39 ;
SYP(BQDFN,RESULT) ;EP - Syphilis
+1 NEW UID,TREF,TAX,XTP,XSC,DATE
+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("BQITAX",$JOB))
KILL @TREF
+6 ;
+7 Begin DoDot:1
+8 SET TAX="BQI SYPHILIS TP-AB LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+9 SET TAX="BQI SYPHILIS TP-AB TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+10 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
+11 SET XTP=$$LAB^BQICAUTL(TMFRAME,0,BQDFN,"",.SEARCH,.TREF)
+12 KILL @TREF
+13 SET TAX="BQI SYPHILIS REAGIN LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+14 SET TAX="BQI SYPHILIS REAGIN TEST TAX"
DO BLD^BQITUTL(TAX,.TREF,"L")
+15 SET SEARCH(1)="POS"_U_"="
SET SEARCH(2)="0"_U_">"
SET DATE=$PIECE(XTP,U,2)
+16 SET XSC=$$LBB^BQICAUTL(30,0,DATE,BQDFN,"",.SEARCH,.TREF)
+17 KILL @TREF
+18 IF 'XTP
IF 'XSC
QUIT
+19 IF XSC
Begin DoDot:2
+20 NEW XBGS,XBES
+21 SET XBGS=$PIECE(XSC,U,2)
SET XBES=DT
+22 SET XFPS=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGS,XBES)
+23 IF XFPS
SET XSC=0
End DoDot:2
+24 IF XTP
Begin DoDot:2
+25 SET XBGT=$PIECE(XTP,U,2)
SET XBET=DT
+26 SET XFPT=$$TAX^BQITRUTL("","BQI SYPHILIS FALSE POS DXS",1,BQDFN,9000010.07,"","",.TREF,XBGT,XBET)
+27 IF XFPT
SET XTP=0
End DoDot:2
End DoDot:1
+28 ;
+29 IF XTP
IF XSC
Begin DoDot:1
+30 DO LB^BQICAEP1(XTP,CT)
SET CT=CT+1
+31 DO LB^BQICAEP1(XSC,CT)
End DoDot:1
+32 KILL SEARCH,@TREF
+33 QUIT
+34 ;
HIB(BQDFN,RESULT) ;EP - HIB Flu
+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("BQITAX",$JOB))
KILL @TREF
+6 FOR TAX="BQI HIB QUAL TEST LOINC","BQI HIB CULTURE TEST LOINC","BQI HIB QUANT TEST LOINC"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BQI HIB QUAL TEST TAX","BQI HIB CULTURE TEST TAX","BQI HIB 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^BQICAEP1(X,CT)
+11 KILL SEARCH,@TREF
+12 QUIT
+13 ;
DXF(BQX) ;EP - Diagnosis
+1 NEW VSDTM,TIEN,VISIT,IEN
+2 SET VSDTM=$PIECE(BQX,U,2)
SET VISIT=$PIECE(BQX,U,4)
SET IEN=$PIECE(BQX,U,5)
SET TIEN=$PIECE(^AUPNVPOV(IEN,0),U,1)
+3 SET @DATA@(COMM,ALRT,BQDFN,"DX",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.07"
+4 QUIT
+5 ;
MSF(BQX) ;EP - Measurement
+1 NEW VSDTM,TIEN,VISIT,IEN
+2 SET VSDTM=$PIECE(BQX,U,2)
SET VISIT=$PIECE(BQX,U,4)
SET IEN=$PIECE(BQX,U,5)
SET TIEN=$PIECE(^AUPNVMSR(IEN,0),U,1)
+3 SET @DATA@(COMM,ALRT,BQDFN,"MS",VSDTM,TIEN)=VISIT_U_IEN_U_"9000010.01"
+4 QUIT
+5 ;
BCG(BQDFN,TMFRAME) ;EP - BCG Vaccination
+1 ; immunization BCG or 19
+2 ; cpt codes 90728 or 90585
+3 ; icd9 diagnosis V03.2
+4 ; icd9 procedure 99.33
+5 ;
+6 NEW ENDT,STDT,BGDT,BQIM,QFL,IEN,VIEN,TIEN,RES,TREF,BPOV
+7 SET RES=0
+8 IF $GET(TMFRAME)'=""
SET ENDT=(9999999-$$DATE^BQIUL1(TMFRAME))
SET BGDT=9999999-DT
SET STDT=ENDT-.0001
+9 IF $GET(TMFRAME)=""
SET STDT=""
SET ENDT=""
+10 ;
+11 ; Check BCG immunization
+12 SET BQIM=$ORDER(^AUTTIMM("B","BCG",""))
IF BQIM'=""
Begin DoDot:1
+13 SET QFL=0
IF ENDT=""
SET ENDT=$ORDER(^AUPNVIMM("AA",BQDFN,BQIM,STDT),-1)
+14 FOR
SET STDT=$ORDER(^AUPNVIMM("AA",BQDFN,BQIM,STDT))
IF STDT=""!(STDT>ENDT)
QUIT
Begin DoDot:2
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(^AUPNVIMM("AA",BQDFN,BQIM,STDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+17 SET VIEN=$PIECE($GET(^AUPNVIMM(IEN,0)),U,3)
+18 SET RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+19 ;
+20 IF RES
QUIT RES
+21 ; check for ICD9 diagnosis
+22 SET TREF="BQILST"
KILL @TREF
+23 DO BLDSV^BQITUTL(80,"V03.2 ",TREF)
+24 IF $GET(TMFRAME)'=""
SET ENDT=(9999999-$$DATE^BQIUL1(TMFRAME))
SET BGDT=9999999-DT
SET STDT=ENDT-.0001
+25 IF $GET(TMFRAME)=""
SET STDT=""
SET ENDT=""
+26 IF ENDT=""
SET ENDT=$ORDER(^AUPNVPOV("AA",BQDFN,""),-1)
+27 FOR
SET STDT=$ORDER(^AUPNVPOV("AA",BQDFN,STDT))
IF STDT=""!(STDT>ENDT)
QUIT
Begin DoDot:1
+28 SET IEN=""
+29 FOR
SET IEN=$ORDER(^AUPNVPOV("AA",BQDFN,STDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+30 SET BPOV=$PIECE($GET(^AUPNVPOV(IEN,0)),U,1)
IF BPOV=""
QUIT
+31 IF '$DATA(@TREF@(BPOV))
QUIT
+32 SET VIEN=$PIECE(^AUPNVPOV(IEN,0),U,3)
+33 SET RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+34 ;
+35 IF RES
QUIT RES
+36 ;
+37 ; Check for CPT codes
+38 SET TREF="BQILST"
KILL @TREF
+39 DO BLDSV^BQITUTL(81,"90585 ",TREF)
DO BLDSV^BQITUTL(81,"90728 ",TREF)
+40 SET TIEN=""
SET QFL=0
+41 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:1
+42 IF $GET(TMFRAME)'=""
SET ENDT=(9999999-$$DATE^BQIUL1(TMFRAME))
SET BGDT=9999999-DT
SET STDT=ENDT-.0001
+43 IF $GET(TMFRAME)=""
SET STDT=""
SET ENDT=""
+44 IF ENDT=""
SET ENDT=$ORDER(^AUPNVCPT("AA",BQDFN,TIEN,""),-1)
+45 FOR
SET STDT=$ORDER(^AUPNVCPT("AA",BQDFN,TIEN,STDT))
IF STDT=""!(STDT>ENDT)
QUIT
Begin DoDot:2
+46 SET IEN=""
+47 FOR
SET IEN=$ORDER(^AUPNVCPT("AA",BQDFN,TIEN,STDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+48 SET VIEN=$PIECE($GET(^AUPNVCPT(IEN,0)),U,3)
+49 SET RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+50 ;
+51 IF RES
QUIT RES
+52 ;
+53 ; Check for procedure
+54 SET TREF="BQILST"
KILL @TREF
+55 DO BLDSV^BQITUTL(80.1,"99.33 ",TREF)
+56 IF $GET(TMFRAME)'=""
SET ENDT=(9999999-$$DATE^BQIUL1(TMFRAME))
SET BGDT=9999999-DT
SET STDT=ENDT-.0001
+57 IF $GET(TMFRAME)=""
SET STDT=""
SET ENDT=""
+58 IF ENDT=""
SET ENDT=$ORDER(^AUPNVPRC("AA",BQDFN,""),-1)
+59 FOR
SET STDT=$ORDER(^AUPNVPRC("AA",BQDFN,STDT))
IF STDT=""!(STDT>ENDT)
QUIT
Begin DoDot:1
+60 SET IEN=""
+61 FOR
SET IEN=$ORDER(^AUPNVPRC("AA",BQDFN,STDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+62 SET BPOV=$PIECE($GET(^AUPNVPRC(IEN,0)),U,1)
IF BPOV=""
QUIT
+63 IF '$DATA(@TREF@(BPOV))
QUIT
+64 SET VIEN=$PIECE(^AUPNVPRC(IEN,0),U,3)
+65 SET RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+66 KILL @TREF
+67 QUIT RES
+68 ;
SKTST(BQDFN,TMFRAME) ;EP - Skin Test
+1 NEW SKN,ENDT,STDT,BGDT,IEN,VIEN,RES,VALUE
+2 SET SKN=$$FIND1^DIC(9999999.28,,"X","PPD")
+3 SET RES=0
+4 IF $GET(TMFRAME)'=""
SET ENDT=(9999999-$$DATE^BQIUL1(TMFRAME))
SET BGDT=9999999-DT
SET STDT=ENDT-.0001
+5 IF $GET(TMFRAME)=""
SET STDT=""
SET ENDT=""
+6 IF ENDT=""
SET ENDT=$ORDER(^AUPNVSK("AA",BQDFN,SKN,""),-1)
+7 FOR
SET STDT=$ORDER(^AUPNVSK("AA",BQDFN,SKN,STDT))
IF STDT=""!(STDT>ENDT)
QUIT
Begin DoDot:1
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^AUPNVSK("AA",BQDFN,SKN,STDT,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+10 SET VIEN=$PIECE($GET(^AUPNVSK(IEN,0)),U,3)
IF VIEN=""
QUIT
+11 ; If the reading is greater than 15 mm, then it is positive
+12 SET VALUE=+$PIECE(^AUPNVSK(IEN,0),U,5)'>15
QUIT
+13 SET RES=1_U_$$FMTE^BQIUL1((9999999-STDT))_U_U_VIEN_U_IEN_U_"9000010.12"
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+14 QUIT RES
