BKMQQCR2 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
; Quality of Care Audit Report
Q
CHLAM ; EP - Chlamydia Tests
N CHDT,SITETAX,LOINTAX,CPTTAX,ICDTAX,PRCTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
S CHDT=$$FMADD^XLFDT(EDATE,-365)
S SITETAX="BGP CHLAMYDIA TESTS TAX"
S LOINTAX="BGP CHLAMYDIA LOINC CODES"
S CPTTAX="BTPW CHLAMYDIA CPTS"
;S PRCTAX="BGP CHLAMYDIA TEST PROCEDURES"
S ICDTAX="BQI CHLAMYDIA SCREEN DXS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAM"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAMREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CHLAMPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CHDT,GLOBAL)
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CHDT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CHDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CHDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CHDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CHDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CHDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"CHLAM"))!$D(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF")) S @TOTPTS=@TOTPTS+1
Q
GON ; EP - Gonorrhea Tests
N GONDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
S GONDT=$$FMADD^XLFDT(EDATE,-365)
S SITETAX="BKM GONORRHEA TEST TAX"
S LOINTAX="BKM GONORRHEA LOINC CODES"
S CPTTAX="BKM GONORRHEA TESTS CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""GON"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""GONREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""GONPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,GONDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,GONDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,GONDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,GONDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,GONDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"GON"))!$D(@GLOB@("HIVCHK",BKMDFN,"GONREF")) S @TOTPTS=@TOTPTS+1
Q
TBT21 ; EP - Tuberculosis Status
N TBT21DT,SITETAX,LOINTAX,CPTTAX,CVXTAX,ICDTAX,ICDTAX1,MEDTAX,NDCTAX
N GLOBAL,GLOBAL1,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
S TBT21DT=""
S CPTTAX="BKM PPD CPTS"
S LOINTAX="BKM PPD LOINC CODES"
S SITETAX="BKM PPD TAX"
S CVXTAX="BKM PPD CVX CODES"
S ICDTAX="BKM PPD ICDS"
S ICDTAX1="DM AUDIT PROBLEM TB DXS"
S MEDTAX="BKM TB MEDS"
S NDCTAX="BKM TB MED NDCS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21"",VSTDT,TEST)"
S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21MED"",VSTDT,TEST)"
S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21DX"",VSTDT,TEST)"
S GLOBAL3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21POSNEG"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21REF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""TBT21PTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TBT21DT,GLOBAL)
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,TBT21DT,GLOBAL2)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TBT21DT,GLOBAL)
.D SKNTAX^BKMIXX1(BKMDFN,"21",EDATE,TBT21DT,GLOBAL3)
.D CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,TBT21DT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,TBT21DT,GLOBAL3)
.M @GLOB@("HIVCHK",BKMDFN,"TBT21")=@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG")
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,TBT21DT,GLOBAL)
.D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,TBT21DT,GLOBAL1)
.D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,TBT21DT,GLOBAL1)
.D REFUSAL^BKMIXX2(BKMDFN,9999999.28,"21",EDATE,TBT21DT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,TBT21DT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,TBT21DT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,TBT21DT,REFGLOB)
.; Store Medication refusals in same global as regular Medications.
.D REFUSAL^BKMIXX2(BKMDFN,50,MEDTAX,EDATE,TBT21DT,GLOBAL1)
.D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,TBT21DT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"TBT21"))!$D(@GLOB@("HIVCHK",BKMDFN,"TBT21REF"))!$D(@GLOB@("HIVCHK",BKMDFN,"TBT21MED")) S @TOTPTS=@TOTPTS+1 Q
Q
PNEUMO ; EP - Pneumovax Status
N PNEUMODT,CPTTAX,CVXTAX,ICDTAX,PRCTAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN
S PNEUMODT=""
S CVXTAX="BKM PNEUMO IZ CVX CODES"
S ICDTAX="BQI PNEUMO IZ DXS"
S PRCTAX="BQI PNEUMO IZ PROCEDURES"
S CPTTAX="BGP PNEUMO IZ CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMO"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMOREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""PNEUMOCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,PNEUMODT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,PNEUMODT,GLOBAL)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,PNEUMODT,GLOBAL)
.D CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,PNEUMODT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,PNEUMODT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"PNEUMO"))!$D(@GLOB@("HIVCHK",BKMDFN,"PNEUMOREF")) S @TOTPTS=@TOTPTS+1
Q
LIPIDS ; EP - Lipids Screening
N LIPDT,LOINTAX,LABTAX,GLOBAL,REFGLOB,GLOBAL1,TOTPTS,BKMDFN,MEDTAX,NDCTAX,CPTTAX
S LIPDT=$$FMADD^XLFDT(EDATE,-365)
S LOINTAX="BGP LIPID PROFILE LOINC CODES"
S CPTTAX="BGP LIPID PROFILE CPTS"
S SITETAX="DM AUDIT LIPID PROFILE TAX"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPID"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDREF"",VSTDT,TEST)"
S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDARV"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""LIPIDCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,LIPDT,GLOBAL)
.;D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,LIPDT,GLOBAL)
.D GETLAB(LOINTAX,BKMDFN,EDATE,LIPDT,GLOBAL)
.D GETLAB(SITETAX,BKMDFN,EDATE,LIPDT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,LIPDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,LIPDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,LIPDT,REFGLOB)
.I '$D(@GLOB@("HIVCHK",BKMDFN,"LIPID")),'$D(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF")) Q
.S @TOTPTS=@TOTPTS+1
.I '$D(@GLOB@("HIVCHK",BKMDFN,"LIPID")) Q
.; Identify who is receiving ARV meds
.F MEDTAX="BKMV NNRTI MEDS","BKMV NRTI MEDS","BKMV PI MEDS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
.F MEDTAX="BKMV EI MEDS","BKMV II MEDS","BKMV NRTI/NNRTI MEDS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
.F MEDTAX="BKMV NRTI COMBO MEDS","BKMV PI BOOSTER MEDS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
.F NDCTAX="BKMV NNRTI MED NDCS","BKMV NRTI MED NDCS","BKMV PI MED NDCS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
.F NDCTAX="BKMV EI MED NDCS","BKMV II MED NDCS","BKMV NRTI/NNRTI MED NDCS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
.F NDCTAX="BKMV NRTI COMBO MED NDCS","BKMV PI BOOSTER MED NDCS" D I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
Q
GETLAB(TAX,DFN,EDATE,SDATE,TARGET) ; EP
; Get lab result associated with a lab panel for a patient
;
N RESULT,LAB,LB,IEN,TEST,VISIT,VSTDT
S RESULT=""
D BLDTAX^BKMIXX5(TAX,"LAB")
S LAB=""
F S LAB=$O(LAB(LAB)) Q:LAB="" I $O(^LAB(60,LAB,2)) D
. S IEN=0
. F S IEN=$O(^LAB(60,LAB,2,IEN)) Q:'IEN S LB=$G(^(IEN,0)) I LB'="" S LAB(LB)=""
S TEST="" ;,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
F S TEST=$O(^AUPNVLAB("AC",DFN,TEST),-1) Q:TEST="" D
.S LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
.I LAB="" Q
.I '$D(LAB(LAB)) Q
.S VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
.S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
.I $G(SDATE)'="",(VSTDT<SDATE) Q
.I $G(EDATE)'="",(VSTDT\1>EDATE) Q
.;I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
.;I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
.S RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
.I $G(TARGET)]"" S @TARGET=RESULT
Q
BKMQQCR2 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
+1 ;;2.2;HIV MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 3
+2 ; Quality of Care Audit Report
+3 QUIT
CHLAM ; EP - Chlamydia Tests
+1 NEW CHDT,SITETAX,LOINTAX,CPTTAX,ICDTAX,PRCTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
+2 SET CHDT=$$FMADD^XLFDT(EDATE,-365)
+3 SET SITETAX="BGP CHLAMYDIA TESTS TAX"
+4 SET LOINTAX="BGP CHLAMYDIA LOINC CODES"
+5 SET CPTTAX="BTPW CHLAMYDIA CPTS"
+6 ;S PRCTAX="BGP CHLAMYDIA TEST PROCEDURES"
+7 SET ICDTAX="BQI CHLAMYDIA SCREEN DXS"
+8 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAM"",VSTDT,TEST)"
+9 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAMREF"",VSTDT,TEST)"
+10 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""CHLAMPTCNT"")"
+11 SET BKMDFN=0
SET @TOTPTS=0
+12 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+13 ;D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CHDT,GLOBAL)
+14 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CHDT,GLOBAL)
+15 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CHDT,GLOBAL)
+16 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CHDT,GLOBAL)
+17 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CHDT,GLOBAL)
+18 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CHDT,REFGLOB)
+19 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CHDT,REFGLOB)
+20 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"CHLAM"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+21 QUIT
GON ; EP - Gonorrhea Tests
+1 NEW GONDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
+2 SET GONDT=$$FMADD^XLFDT(EDATE,-365)
+3 SET SITETAX="BKM GONORRHEA TEST TAX"
+4 SET LOINTAX="BKM GONORRHEA LOINC CODES"
+5 SET CPTTAX="BKM GONORRHEA TESTS CPTS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""GON"",VSTDT,TEST)"
+7 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""GONREF"",VSTDT,TEST)"
+8 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""GONPTCNT"")"
+9 SET BKMDFN=0
SET @TOTPTS=0
+10 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+11 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,GONDT,GLOBAL)
+12 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,GONDT,GLOBAL)
+13 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,GONDT,GLOBAL)
+14 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,GONDT,REFGLOB)
+15 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,GONDT,REFGLOB)
+16 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"GON"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"GONREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+17 QUIT
TBT21 ; EP - Tuberculosis Status
+1 NEW TBT21DT,SITETAX,LOINTAX,CPTTAX,CVXTAX,ICDTAX,ICDTAX1,MEDTAX,NDCTAX
+2 NEW GLOBAL,GLOBAL1,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
+3 SET TBT21DT=""
+4 SET CPTTAX="BKM PPD CPTS"
+5 SET LOINTAX="BKM PPD LOINC CODES"
+6 SET SITETAX="BKM PPD TAX"
+7 SET CVXTAX="BKM PPD CVX CODES"
+8 SET ICDTAX="BKM PPD ICDS"
+9 SET ICDTAX1="DM AUDIT PROBLEM TB DXS"
+10 SET MEDTAX="BKM TB MEDS"
+11 SET NDCTAX="BKM TB MED NDCS"
+12 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21"",VSTDT,TEST)"
+13 SET GLOBAL1=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21MED"",VSTDT,TEST)"
+14 SET GLOBAL2=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21DX"",VSTDT,TEST)"
+15 SET GLOBAL3=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21POSNEG"",VSTDT,TEST)"
+16 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21REF"",VSTDT,TEST)"
+17 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""TBT21PTCNT"")"
+18 SET BKMDFN=0
SET @TOTPTS=0
+19 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+20 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TBT21DT,GLOBAL)
+21 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,TBT21DT,GLOBAL2)
+22 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TBT21DT,GLOBAL)
+23 DO SKNTAX^BKMIXX1(BKMDFN,"21",EDATE,TBT21DT,GLOBAL3)
+24 DO CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,TBT21DT,GLOBAL)
+25 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,TBT21DT,GLOBAL3)
+26 MERGE @GLOB@("HIVCHK",BKMDFN,"TBT21")=@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG")
+27 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,TBT21DT,GLOBAL)
+28 DO MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,TBT21DT,GLOBAL1)
+29 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,TBT21DT,GLOBAL1)
+30 DO REFUSAL^BKMIXX2(BKMDFN,9999999.28,"21",EDATE,TBT21DT,REFGLOB)
+31 DO REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,TBT21DT,REFGLOB)
+32 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,TBT21DT,REFGLOB)
+33 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,TBT21DT,REFGLOB)
+34 ; Store Medication refusals in same global as regular Medications.
+35 DO REFUSAL^BKMIXX2(BKMDFN,50,MEDTAX,EDATE,TBT21DT,GLOBAL1)
+36 DO REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,TBT21DT,GLOBAL1)
+37 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"TBT21"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"TBT21REF"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"TBT21MED"))
SET @TOTPTS=@TOTPTS+1
QUIT
End DoDot:1
+38 QUIT
PNEUMO ; EP - Pneumovax Status
+1 NEW PNEUMODT,CPTTAX,CVXTAX,ICDTAX,PRCTAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN
+2 SET PNEUMODT=""
+3 SET CVXTAX="BKM PNEUMO IZ CVX CODES"
+4 SET ICDTAX="BQI PNEUMO IZ DXS"
+5 SET PRCTAX="BQI PNEUMO IZ PROCEDURES"
+6 SET CPTTAX="BGP PNEUMO IZ CPTS"
+7 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMO"",VSTDT,TEST)"
+8 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMOREF"",VSTDT,TEST)"
+9 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""PNEUMOCNT"")"
+10 SET BKMDFN=0
SET @TOTPTS=0
+11 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+12 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,PNEUMODT,GLOBAL)
+13 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,PNEUMODT,GLOBAL)
+14 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,PNEUMODT,GLOBAL)
+15 DO CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,PNEUMODT,GLOBAL)
+16 DO REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,PNEUMODT,REFGLOB)
+17 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"PNEUMO"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"PNEUMOREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+18 QUIT
LIPIDS ; EP - Lipids Screening
+1 NEW LIPDT,LOINTAX,LABTAX,GLOBAL,REFGLOB,GLOBAL1,TOTPTS,BKMDFN,MEDTAX,NDCTAX,CPTTAX
+2 SET LIPDT=$$FMADD^XLFDT(EDATE,-365)
+3 SET LOINTAX="BGP LIPID PROFILE LOINC CODES"
+4 SET CPTTAX="BGP LIPID PROFILE CPTS"
+5 SET SITETAX="DM AUDIT LIPID PROFILE TAX"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPID"",VSTDT,TEST)"
+7 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDREF"",VSTDT,TEST)"
+8 SET GLOBAL1=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDARV"",VSTDT,TEST)"
+9 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""LIPIDCNT"")"
+10 SET BKMDFN=0
SET @TOTPTS=0
+11 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+12 ;D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,LIPDT,GLOBAL)
+13 ;D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,LIPDT,GLOBAL)
+14 DO GETLAB(LOINTAX,BKMDFN,EDATE,LIPDT,GLOBAL)
+15 DO GETLAB(SITETAX,BKMDFN,EDATE,LIPDT,GLOBAL)
+16 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,LIPDT,GLOBAL)
+17 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,LIPDT,REFGLOB)
+18 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,LIPDT,REFGLOB)
+19 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"LIPID"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF"))
QUIT
+20 SET @TOTPTS=@TOTPTS+1
+21 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"LIPID"))
QUIT
+22 ; Identify who is receiving ARV meds
+23 FOR MEDTAX="BKMV NNRTI MEDS","BKMV NRTI MEDS","BKMV PI MEDS"
Begin DoDot:2
+24 DO MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+25 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+26 FOR MEDTAX="BKMV EI MEDS","BKMV II MEDS","BKMV NRTI/NNRTI MEDS"
Begin DoDot:2
+27 DO MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+28 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+29 FOR MEDTAX="BKMV NRTI COMBO MEDS","BKMV PI BOOSTER MEDS"
Begin DoDot:2
+30 DO MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+31 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+32 FOR NDCTAX="BKMV NNRTI MED NDCS","BKMV NRTI MED NDCS","BKMV PI MED NDCS"
Begin DoDot:2
+33 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+34 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+35 FOR NDCTAX="BKMV EI MED NDCS","BKMV II MED NDCS","BKMV NRTI/NNRTI MED NDCS"
Begin DoDot:2
+36 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+37 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
+38 FOR NDCTAX="BKMV NRTI COMBO MED NDCS","BKMV PI BOOSTER MED NDCS"
Begin DoDot:2
+39 DO NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
End DoDot:2
IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
QUIT
End DoDot:1
+40 QUIT
GETLAB(TAX,DFN,EDATE,SDATE,TARGET) ; EP
+1 ; Get lab result associated with a lab panel for a patient
+2 ;
+3 NEW RESULT,LAB,LB,IEN,TEST,VISIT,VSTDT
+4 SET RESULT=""
+5 DO BLDTAX^BKMIXX5(TAX,"LAB")
+6 SET LAB=""
+7 FOR
SET LAB=$ORDER(LAB(LAB))
IF LAB=""
QUIT
IF $ORDER(^LAB(60,LAB,2))
Begin DoDot:1
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(^LAB(60,LAB,2,IEN))
IF 'IEN
QUIT
SET LB=$GET(^(IEN,0))
IF LB'=""
SET LAB(LB)=""
End DoDot:1
+10 ;,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
SET TEST=""
+11 FOR
SET TEST=$ORDER(^AUPNVLAB("AC",DFN,TEST),-1)
IF TEST=""
QUIT
Begin DoDot:1
+12 SET LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
+13 IF LAB=""
QUIT
+14 IF '$DATA(LAB(LAB))
QUIT
+15 SET VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
+16 SET VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
+17 IF $GET(SDATE)'=""
IF (VSTDT<SDATE)
QUIT
+18 IF $GET(EDATE)'=""
IF (VSTDT\1>EDATE)
QUIT
+19 ;I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
+20 ;I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
+21 SET RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
+22 IF $GET(TARGET)]""
SET @TARGET=RESULT
End DoDot:1
+23 QUIT
