BKMCRS ;PRXM/HC/ALA-STI for CRS ; 01 Mar 2007 7:17 PM
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
;
Q
;
; This function cycles through the V-Lab file checking
; each lab, CPT4, ICD9, and LOINC associated with a DFN to
; see if each is in an appropriate taxonomy, old enough,
; and if required positive.
;
; DFN is the patient DFN from file 2 or 9000001.
;
; LABT is the text name of the lab taxonomy.
; LOINCT is the text name of the LOINC taxonomy.
; CPTT is the text name of the CPT taxonomy.
; ICDT is the text name of the ICD9 taxonomy.
;
; BDATE is the base (starting) date for the search.
;
; IDATE is the date of the last item (LAB, LOINC, CPT, or ICD) passed by reference.
;
; LDATE is the date of the last LAB passed by reference.
; LR if there is a LDATE then the LR will be equal to the result.
; LV if there is a LDATE then the LV is the V Lab IEN.
;
; PDATE is the date of the last positive LAB passed by reference.
; PR if there is a PDATE then the PR will be equal to the positive result.
; PV if there is a PDATE then the PV is the V Lab IEN.
;
; NDATE is the date of the last negative LAB passed by reference.
; NR if there is a NDATE then the NR will be equal to the negative result.
; NV if there is a NDATE then the NV is the V Lab IEN.
;
LABCODES(DFN,LABT,LOINCT,CPTT,ICDT,EDATE,BDATE,IDATE,LDATE,LR,PDATE,PR,NDATE,NR,LV) ;EP
; Retrieve lab codes.
N QDATE,QV,TARGET,LABTEST,LAB,LABDT,RESULT
S LABT=$G(LABT,""),LOINCT=$G(LOINCT,""),CPTT=$G(CPTT,""),ICDT=$G(ICDT,""),OFLG=$G(OFLG,""),LV=$G(LV,"")
S BDATE=$G(BDATE,""),IDATE=$G(IDATE,""),LDATE=$G(LDATE,""),PDATE=$G(PDATE,""),NDATE=$G(NDATE,""),ODATE=$G(ODATE,"")
S EDATE=$G(EDATE,"")
S (LR,PR,NR,OR)=""
S TARGET="LABTEST(VSTDT,TEST)"
S QDATE="",QV=""
D LABTAX^BKMIXX(DFN,LABT,EDATE,BDATE,TARGET,.QDATE,.QV)
I QDATE="",$D(LABTEST) D
. S QDATE=$O(LABTEST(""),-1),QV=$O(LABTEST(QDATE,""),-1)
I QDATE'="" D
. S LDATE=QDATE\1
. I QV'="" S TVALN=$P(^AUPNVLAB(QV,0),U,1),PRNM=$P($G(^LAB(60,TVALN,.1)),U,1)
. I '$D(VALUE(BKTY,"NUM",BKNMTY,BKDATE)) S VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" Lab ["_$S(PRNM'="":PRNM,1:$P($G(^LAB(60,TVALN,0)),U,1))_"]"_U_QV
S IDATE=QDATE,LDATE=QDATE,LV=QV
K LABTEST
S QDATE="",QV=""
D LOINC^BKMIXX(DFN,LOINCT,EDATE,BDATE,TARGET,.QDATE,.QV)
I QDATE="",$D(LABTEST) D
. S QDATE=$O(LABTEST(""),-1),QV=$O(LABTEST(QDATE,""),-1)
I QDATE'="" D
. S LDATE=QDATE\1
. I QV'="" S TVALN=$P(^AUPNVLAB(QV,0),U,1),PRNM=$P($G(^LAB(60,TVALN,.1)),U,1)
. I '$D(VALUE(BKTY,"NUM",BKNMTY,BKDATE)) S VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" Lab ["_$S(PRNM'="":PRNM,1:$P($G(^LAB(60,TVALN,0)),U,1))_"]"_U_QV
;I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
K LABTEST
S QDATE="",QV=""
D CPTTAX^BKMIXX(DFN,CPTT,EDATE,BDATE,TARGET,.QDATE,.QV)
I QDATE="",$D(LABTEST) D
. S QDATE=$O(LABTEST(""),-1),QV=$O(LABTEST(QDATE,""),-1)
I QDATE'="" D
. S LDATE=QDATE\1
. I QV'="" S TVALN=$P(^AUPNVCPT(QV,0),U,1) D
.. I $$VERSION^XPDUTL("BCSV") S PRNM=$$ICPT^BKMUL3(TVALN,LDATE,2) Q ; csv
.. S PRNM=$P($G(^ICPT(TVALN,0)),U,1)
. I '$D(VALUE(BKTY,"NUM",BKNMTY,BKDATE)) S VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" CPT ["_PRNM_"]"_U_QV
;I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
K LABTEST
S QDATE="",QV=""
D ICDTAX^BKMIXX1(DFN,ICDT,EDATE,BDATE,TARGET,.QDATE,.QV)
I QDATE="",$D(LABTEST) D
. S QDATE=$O(LABTEST(""),-1),QV=$O(LABTEST(QDATE,""),-1)
I QDATE'="" D
. S LDATE=QDATE\1
. I QV'="" S TVALN=$P(^AUPNVPOV(QV,0),U,1) D
.. I $$VERSION^XPDUTL("BCSV") S PRNM=$$ICD9^BKMUL3(TVALN,LDATE,2) Q ; csv
.. S PRNM=$P($G(^ICD9(TVALN,0)),U,1)
. I '$D(VALUE(BKTY,"NUM",BKNMTY,BKDATE)) S VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" POV ["_PRNM_"]"_U_QV
Q
;
HREF ; HIV Refusals
S GLOBAL="BKMT(""HIV"",VSTDT,TEST,""LAB"")" D REFUSAL^BKMIXX2(BKMDFN,60,"BGP HIV TEST TAX","","",GLOBAL)
S GLOBAL="BKMT(""HIV"",VSTDT,TEST,""CPT"")" D REFUSAL^BKMIXX2(BKMDFN,81,"BGP CPT HIV TESTS","","",GLOBAL)
Q
;
CLRF ; Chlamydia Refusals
S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")" D REFUSAL^BKMIXX2(BKMDFN,60,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
S GLOBAL="BKMT(""CHL"",VSTDT,TEST,""CPT"")" D REFUSAL^BKMIXX2(BKMDFN,81,"BTPW CHLAMYDIA CPTS","","",GLOBAL)
Q
;
GRF ; Gonorrhea Refusals
S GLOBAL="BKMT(""GC"",VSTDT,TEST,""LAB"")" D REFUSAL^BKMIXX2(BKMDFN,60,"BKM GONORRHEA TEST TAX","","",GLOBAL)
S GLOBAL="BKMT(""GC"",VSTDT,TEST,""CPT"")" D REFUSAL^BKMIXX2(BKMDFN,81,"BKM GONORRHEA TESTS CPTS","","",GLOBAL)
Q
BKMCRS ;PRXM/HC/ALA-STI for CRS ; 01 Mar 2007 7:17 PM
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
+2 ;
+3 QUIT
+4 ;
+5 ; This function cycles through the V-Lab file checking
+6 ; each lab, CPT4, ICD9, and LOINC associated with a DFN to
+7 ; see if each is in an appropriate taxonomy, old enough,
+8 ; and if required positive.
+9 ;
+10 ; DFN is the patient DFN from file 2 or 9000001.
+11 ;
+12 ; LABT is the text name of the lab taxonomy.
+13 ; LOINCT is the text name of the LOINC taxonomy.
+14 ; CPTT is the text name of the CPT taxonomy.
+15 ; ICDT is the text name of the ICD9 taxonomy.
+16 ;
+17 ; BDATE is the base (starting) date for the search.
+18 ;
+19 ; IDATE is the date of the last item (LAB, LOINC, CPT, or ICD) passed by reference.
+20 ;
+21 ; LDATE is the date of the last LAB passed by reference.
+22 ; LR if there is a LDATE then the LR will be equal to the result.
+23 ; LV if there is a LDATE then the LV is the V Lab IEN.
+24 ;
+25 ; PDATE is the date of the last positive LAB passed by reference.
+26 ; PR if there is a PDATE then the PR will be equal to the positive result.
+27 ; PV if there is a PDATE then the PV is the V Lab IEN.
+28 ;
+29 ; NDATE is the date of the last negative LAB passed by reference.
+30 ; NR if there is a NDATE then the NR will be equal to the negative result.
+31 ; NV if there is a NDATE then the NV is the V Lab IEN.
+32 ;
LABCODES(DFN,LABT,LOINCT,CPTT,ICDT,EDATE,BDATE,IDATE,LDATE,LR,PDATE,PR,NDATE,NR,LV) ;EP
+1 ; Retrieve lab codes.
+2 NEW QDATE,QV,TARGET,LABTEST,LAB,LABDT,RESULT
+3 SET LABT=$GET(LABT,"")
SET LOINCT=$GET(LOINCT,"")
SET CPTT=$GET(CPTT,"")
SET ICDT=$GET(ICDT,"")
SET OFLG=$GET(OFLG,"")
SET LV=$GET(LV,"")
+4 SET BDATE=$GET(BDATE,"")
SET IDATE=$GET(IDATE,"")
SET LDATE=$GET(LDATE,"")
SET PDATE=$GET(PDATE,"")
SET NDATE=$GET(NDATE,"")
SET ODATE=$GET(ODATE,"")
+5 SET EDATE=$GET(EDATE,"")
+6 SET (LR,PR,NR,OR)=""
+7 SET TARGET="LABTEST(VSTDT,TEST)"
+8 SET QDATE=""
SET QV=""
+9 DO LABTAX^BKMIXX(DFN,LABT,EDATE,BDATE,TARGET,.QDATE,.QV)
+10 IF QDATE=""
IF $DATA(LABTEST)
Begin DoDot:1
+11 SET QDATE=$ORDER(LABTEST(""),-1)
SET QV=$ORDER(LABTEST(QDATE,""),-1)
End DoDot:1
+12 IF QDATE'=""
Begin DoDot:1
+13 SET LDATE=QDATE\1
+14 IF QV'=""
SET TVALN=$PIECE(^AUPNVLAB(QV,0),U,1)
SET PRNM=$PIECE($GET(^LAB(60,TVALN,.1)),U,1)
+15 IF '$DATA(VALUE(BKTY,"NUM",BKNMTY,BKDATE))
SET VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" Lab ["_$SELECT(PRNM'="":PRNM,1:$PIECE($GET(^LAB(60,TVALN,0)),U,1))_"]"_U_QV
End DoDot:1
+16 SET IDATE=QDATE
SET LDATE=QDATE
SET LV=QV
+17 KILL LABTEST
+18 SET QDATE=""
SET QV=""
+19 DO LOINC^BKMIXX(DFN,LOINCT,EDATE,BDATE,TARGET,.QDATE,.QV)
+20 IF QDATE=""
IF $DATA(LABTEST)
Begin DoDot:1
+21 SET QDATE=$ORDER(LABTEST(""),-1)
SET QV=$ORDER(LABTEST(QDATE,""),-1)
End DoDot:1
+22 IF QDATE'=""
Begin DoDot:1
+23 SET LDATE=QDATE\1
+24 IF QV'=""
SET TVALN=$PIECE(^AUPNVLAB(QV,0),U,1)
SET PRNM=$PIECE($GET(^LAB(60,TVALN,.1)),U,1)
+25 IF '$DATA(VALUE(BKTY,"NUM",BKNMTY,BKDATE))
SET VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" Lab ["_$SELECT(PRNM'="":PRNM,1:$PIECE($GET(^LAB(60,TVALN,0)),U,1))_"]"_U_QV
End DoDot:1
+26 ;I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
+27 KILL LABTEST
+28 SET QDATE=""
SET QV=""
+29 DO CPTTAX^BKMIXX(DFN,CPTT,EDATE,BDATE,TARGET,.QDATE,.QV)
+30 IF QDATE=""
IF $DATA(LABTEST)
Begin DoDot:1
+31 SET QDATE=$ORDER(LABTEST(""),-1)
SET QV=$ORDER(LABTEST(QDATE,""),-1)
End DoDot:1
+32 IF QDATE'=""
Begin DoDot:1
+33 SET LDATE=QDATE\1
+34 IF QV'=""
SET TVALN=$PIECE(^AUPNVCPT(QV,0),U,1)
Begin DoDot:2
+35 ; csv
IF $$VERSION^XPDUTL("BCSV")
SET PRNM=$$ICPT^BKMUL3(TVALN,LDATE,2)
QUIT
+36 SET PRNM=$PIECE($GET(^ICPT(TVALN,0)),U,1)
End DoDot:2
+37 IF '$DATA(VALUE(BKTY,"NUM",BKNMTY,BKDATE))
SET VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" CPT ["_PRNM_"]"_U_QV
End DoDot:1
+38 ;I QDATE>IDATE S IDATE=QDATE,LDATE=QDATE,LV=QV
+39 KILL LABTEST
+40 SET QDATE=""
SET QV=""
+41 DO ICDTAX^BKMIXX1(DFN,ICDT,EDATE,BDATE,TARGET,.QDATE,.QV)
+42 IF QDATE=""
IF $DATA(LABTEST)
Begin DoDot:1
+43 SET QDATE=$ORDER(LABTEST(""),-1)
SET QV=$ORDER(LABTEST(QDATE,""),-1)
End DoDot:1
+44 IF QDATE'=""
Begin DoDot:1
+45 SET LDATE=QDATE\1
+46 IF QV'=""
SET TVALN=$PIECE(^AUPNVPOV(QV,0),U,1)
Begin DoDot:2
+47 ; csv
IF $$VERSION^XPDUTL("BCSV")
SET PRNM=$$ICD9^BKMUL3(TVALN,LDATE,2)
QUIT
+48 SET PRNM=$PIECE($GET(^ICD9(TVALN,0)),U,1)
End DoDot:2
+49 IF '$DATA(VALUE(BKTY,"NUM",BKNMTY,BKDATE))
SET VALUE(BKTY,"NUM",BKNMTY,BKDATE)=1_U_$$FMTE^XLFDT(LDATE,"2Z")_" POV ["_PRNM_"]"_U_QV
End DoDot:1
+50 QUIT
+51 ;
HREF ; HIV Refusals
+1 SET GLOBAL="BKMT(""HIV"",VSTDT,TEST,""LAB"")"
DO REFUSAL^BKMIXX2(BKMDFN,60,"BGP HIV TEST TAX","","",GLOBAL)
+2 SET GLOBAL="BKMT(""HIV"",VSTDT,TEST,""CPT"")"
DO REFUSAL^BKMIXX2(BKMDFN,81,"BGP CPT HIV TESTS","","",GLOBAL)
+3 QUIT
+4 ;
CLRF ; Chlamydia Refusals
+1 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""LAB"")"
DO REFUSAL^BKMIXX2(BKMDFN,60,"BGP CHLAMYDIA TESTS TAX","","",GLOBAL)
+2 SET GLOBAL="BKMT(""CHL"",VSTDT,TEST,""CPT"")"
DO REFUSAL^BKMIXX2(BKMDFN,81,"BTPW CHLAMYDIA CPTS","","",GLOBAL)
+3 QUIT
+4 ;
GRF ; Gonorrhea Refusals
+1 SET GLOBAL="BKMT(""GC"",VSTDT,TEST,""LAB"")"
DO REFUSAL^BKMIXX2(BKMDFN,60,"BKM GONORRHEA TEST TAX","","",GLOBAL)
+2 SET GLOBAL="BKMT(""GC"",VSTDT,TEST,""CPT"")"
DO REFUSAL^BKMIXX2(BKMDFN,81,"BKM GONORRHEA TESTS CPTS","","",GLOBAL)
+3 QUIT
