Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMQQCR2

BKMQQCR2.m

Go to the documentation of this file. 
  1. 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
  1.  ; Quality of Care Audit Report
  1.  Q
  1. CHLAM ; EP - Chlamydia Tests
  1.  N CHDT,SITETAX,LOINTAX,CPTTAX,ICDTAX,PRCTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
  1.  S CHDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S SITETAX="BGP CHLAMYDIA TESTS TAX"
  1.  S LOINTAX="BGP CHLAMYDIA LOINC CODES"
  1.  S CPTTAX="BTPW CHLAMYDIA CPTS"
  1.  ;S PRCTAX="BGP CHLAMYDIA TEST PROCEDURES"
  1.  S ICDTAX="BQI CHLAMYDIA SCREEN DXS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAM"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CHLAMREF"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CHLAMPTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .;D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CHDT,GLOBAL)
  1.  .D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CHDT,GLOBAL)
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CHDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CHDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CHDT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CHDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CHDT,REFGLOB)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"CHLAM"))!$D(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. GON ; EP - Gonorrhea Tests
  1.  N GONDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
  1.  S GONDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S SITETAX="BKM GONORRHEA TEST TAX"
  1.  S LOINTAX="BKM GONORRHEA LOINC CODES"
  1.  S CPTTAX="BKM GONORRHEA TESTS CPTS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""GON"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""GONREF"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""GONPTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,GONDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,GONDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,GONDT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,GONDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,GONDT,REFGLOB)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"GON"))!$D(@GLOB@("HIVCHK",BKMDFN,"GONREF")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. TBT21 ; EP - Tuberculosis Status
  1.  N TBT21DT,SITETAX,LOINTAX,CPTTAX,CVXTAX,ICDTAX,ICDTAX1,MEDTAX,NDCTAX
  1.  N GLOBAL,GLOBAL1,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
  1.  S TBT21DT=""
  1.  S CPTTAX="BKM PPD CPTS"
  1.  S LOINTAX="BKM PPD LOINC CODES"
  1.  S SITETAX="BKM PPD TAX"
  1.  S CVXTAX="BKM PPD CVX CODES"
  1.  S ICDTAX="BKM PPD ICDS"
  1.  S ICDTAX1="DM AUDIT PROBLEM TB DXS"
  1.  S MEDTAX="BKM TB MEDS"
  1.  S NDCTAX="BKM TB MED NDCS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21"",VSTDT,TEST)"
  1.  S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21MED"",VSTDT,TEST)"
  1.  S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21DX"",VSTDT,TEST)"
  1.  S GLOBAL3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21POSNEG"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TBT21REF"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""TBT21PTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TBT21DT,GLOBAL)
  1.  .D ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,TBT21DT,GLOBAL2)
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TBT21DT,GLOBAL)
  1.  .D SKNTAX^BKMIXX1(BKMDFN,"21",EDATE,TBT21DT,GLOBAL3)
  1.  .D CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,TBT21DT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,TBT21DT,GLOBAL3)
  1.  .M @GLOB@("HIVCHK",BKMDFN,"TBT21")=@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG")
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,TBT21DT,GLOBAL)
  1.  .D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,TBT21DT,GLOBAL1)
  1.  .D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,TBT21DT,GLOBAL1)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,9999999.28,"21",EDATE,TBT21DT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,TBT21DT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,TBT21DT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,TBT21DT,REFGLOB)
  1.  .; Store Medication refusals in same global as regular Medications.
  1.  .D REFUSAL^BKMIXX2(BKMDFN,50,MEDTAX,EDATE,TBT21DT,GLOBAL1)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,50,NDCTAX,EDATE,TBT21DT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"TBT21"))!$D(@GLOB@("HIVCHK",BKMDFN,"TBT21REF"))!$D(@GLOB@("HIVCHK",BKMDFN,"TBT21MED")) S @TOTPTS=@TOTPTS+1 Q
  1.  Q
  1. PNEUMO ; EP - Pneumovax Status
  1.  N PNEUMODT,CPTTAX,CVXTAX,ICDTAX,PRCTAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN
  1.  S PNEUMODT=""
  1.  S CVXTAX="BKM PNEUMO IZ CVX CODES"
  1.  S ICDTAX="BQI PNEUMO IZ DXS"
  1.  S PRCTAX="BQI PNEUMO IZ PROCEDURES"
  1.  S CPTTAX="BGP PNEUMO IZ CPTS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMO"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PNEUMOREF"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""PNEUMOCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,PNEUMODT,GLOBAL)
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,PNEUMODT,GLOBAL)
  1.  .D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,PNEUMODT,GLOBAL)
  1.  .D CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,PNEUMODT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,PNEUMODT,REFGLOB)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"PNEUMO"))!$D(@GLOB@("HIVCHK",BKMDFN,"PNEUMOREF")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. LIPIDS ; EP - Lipids Screening
  1.  N LIPDT,LOINTAX,LABTAX,GLOBAL,REFGLOB,GLOBAL1,TOTPTS,BKMDFN,MEDTAX,NDCTAX,CPTTAX
  1.  S LIPDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S LOINTAX="BGP LIPID PROFILE LOINC CODES"
  1.  S CPTTAX="BGP LIPID PROFILE CPTS"
  1.  S SITETAX="DM AUDIT LIPID PROFILE TAX"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPID"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDREF"",VSTDT,TEST)"
  1.  S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""LIPIDARV"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""LIPIDCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .;D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,LIPDT,GLOBAL)
  1.  .;D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,LIPDT,GLOBAL)
  1.  .D GETLAB(LOINTAX,BKMDFN,EDATE,LIPDT,GLOBAL)
  1.  .D GETLAB(SITETAX,BKMDFN,EDATE,LIPDT,GLOBAL)
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,LIPDT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,LIPDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,LIPDT,REFGLOB)
  1.  .I '$D(@GLOB@("HIVCHK",BKMDFN,"LIPID")),'$D(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF")) Q
  1.  .S @TOTPTS=@TOTPTS+1
  1.  .I '$D(@GLOB@("HIVCHK",BKMDFN,"LIPID")) Q
  1.  .; Identify who is receiving ARV meds
  1.  .F MEDTAX="BKMV NNRTI MEDS","BKMV NRTI MEDS","BKMV PI MEDS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  .F MEDTAX="BKMV EI MEDS","BKMV II MEDS","BKMV NRTI/NNRTI MEDS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  .F MEDTAX="BKMV NRTI COMBO MEDS","BKMV PI BOOSTER MEDS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D MEDTAX^BKMIXX(BKMDFN,MEDTAX,EDATE,LIPDT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  .F NDCTAX="BKMV NNRTI MED NDCS","BKMV NRTI MED NDCS","BKMV PI MED NDCS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  .F NDCTAX="BKMV EI MED NDCS","BKMV II MED NDCS","BKMV NRTI/NNRTI MED NDCS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  .F NDCTAX="BKMV NRTI COMBO MED NDCS","BKMV PI BOOSTER MED NDCS" D  I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) Q
  1.  ..D NDCTAX^BKMIXX1(BKMDFN,NDCTAX,EDATE,LIPDT,GLOBAL1)
  1.  Q
  1. GETLAB(TAX,DFN,EDATE,SDATE,TARGET) ; EP
  1.  ; Get lab result associated with a lab panel for a patient
  1.  ;
  1.  N RESULT,LAB,LB,IEN,TEST,VISIT,VSTDT
  1.  S RESULT=""
  1.  D BLDTAX^BKMIXX5(TAX,"LAB")
  1.  S LAB=""
  1.  F  S LAB=$O(LAB(LAB)) Q:LAB=""  I $O(^LAB(60,LAB,2)) D
  1.  . S IEN=0
  1.  . F  S IEN=$O(^LAB(60,LAB,2,IEN)) Q:'IEN  S LB=$G(^(IEN,0)) I LB'="" S LAB(LB)=""
  1.  S TEST="" ;,LDATE=$G(LDATE,""),LIEN=$G(LIEN,"")
  1.  F  S TEST=$O(^AUPNVLAB("AC",DFN,TEST),-1) Q:TEST=""  D
  1.  .S LAB=$$GET1^DIQ(9000010.09,TEST,.01,"I")
  1.  .I LAB="" Q
  1.  .I '$D(LAB(LAB)) Q
  1.  .S VISIT=$$GET1^DIQ(9000010.09,TEST,.03,"I")
  1.  .S VSTDT=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
  1.  .I $G(SDATE)'="",(VSTDT<SDATE) Q
  1.  .I $G(EDATE)'="",(VSTDT\1>EDATE) Q
  1.  .;I VSTDT>LDATE S LDATE=VSTDT,LIEN=TEST
  1.  .;I VSTDT=LDATE,TEST>LIEN S LDATE=VSTDT,LIEN=TEST
  1.  .S RESULT=$$GET1^DIQ(9000010.09,TEST,.04,"I")
  1.  .I $G(TARGET)]"" S @TARGET=RESULT
  1.  Q