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

BKMQQCR1.m

Go to the documentation of this file. 
  1. BKMQQCR1 ;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. CD4CHK ; EP - CD4 algorithm
  1.  N HIVDT,HIVDT12,SITETAX,SITETAX1,LOINTAX,LOINTAX1,CPTTAX,CPTTAX1,GLOBAL,GLOBAL2,GLOBAL3
  1.  N TOTPTS,BKMDFN,TREF
  1.  S HIVDT=$$FMADD^XLFDT(EDATE,-122) ;***
  1.  S HIVDT12=$$FMADD^XLFDT(EDATE,-365) ; CD4 last 12 months for PCP and MAC Prophylaxis
  1.  S TREF=$NA(^TMP("BKMTAX",UID)) K @TREF
  1.  S SITETAX="BGP CD4 TAX"
  1.  S SITETAX1="BKMV CD4 ABS TESTS TAX"
  1.  S LOINTAX="BGP CD4 LOINC CODES"
  1.  S LOINTAX1="BKMV CD4 ABS LOINC CODES"
  1.  S CPTTAX="BGP CD4 CPTS"
  1.  S CPTTAX1="BKMV CD4 ABS CPTS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ALL"",VSTDT,TEST)"
  1.  S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS"",VSTDT,TEST)"
  1.  S GLOBAL3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS12"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CD4PTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .N CPT,EDT,HDT,GBL
  1.  .S CPT=CPTTAX_$C(29)_CPTTAX1_$C(29)_CPTTAX1
  1.  .S EDT=EDATE_$C(29)_EDATE_$C(29)_EDATE
  1.  .S HDT=HIVDT_$C(29)_HIVDT_$C(29)_HIVDT12
  1.  .S GBL=GLOBAL_$C(29)_GLOBAL2_$C(29)_GLOBAL3
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
  1.  .K CPT,EDT,HDT,GBL
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HIVDT,GLOBAL)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT,GLOBAL2)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT12,GLOBAL3)
  1.  .;F TAX=LOINCTAX,SITETAX D BLDTAX^BKMIXX5(TAX,.TREF)
  1.  .;D LAB^BKMIXX6(BKMDFN,.TREF,EDATE,HIVDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HIVDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HIVDT,GLOBAL)
  1.  .;
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT,GLOBAL2)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT,GLOBAL2)
  1.  .;
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT12,GLOBAL3)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT12,GLOBAL3)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"CD4ALL"))!$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. VRLLD ; EP - Viral Load Check
  1.  N VRLDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,TOTPTS,BKMDFN
  1.  S VRLDT=$$FMADD^XLFDT(EDATE,-122) ;***
  1.  S SITETAX="BGP HIV VIRAL LOAD TAX"
  1.  S LOINTAX="BGP VIRAL LOAD LOINC CODES"
  1.  S CPTTAX="BGP HIV VIRAL LOAD CPTS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VRL"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""VRLPTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,VRLDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,VRLDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VRLDT,GLOBAL)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"VRL")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. RPR ; EP - Rapid Plasma Reagin tests
  1.  N RPRDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
  1.  N SITETAX1,LOINTAX1,CPTTAX1
  1.  S RPRDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S SITETAX="BKM RPR TAX"
  1.  S LOINTAX="BKM RPR LOINC CODES"
  1.  S CPTTAX="BKM RPR CPTS"
  1.  S SITETAX1="BKM FTA-ABS TEST TAX"
  1.  S LOINTAX1="BKM FTA-ABS LOINC CODES"
  1.  S CPTTAX1="BKM FTA-ABS CPTS"
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""RPR"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""RPRREF"",VSTDT,TEST)"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""RPRPTCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,RPRDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,RPRDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,RPRDT,GLOBAL)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,RPRDT,GLOBAL)
  1.  .N CPT,EDT,RDT,GBL
  1.  .S CPT=CPTTAX_$C(29)_CPTTAX1
  1.  .S EDT=EDATE_$C(29)_EDATE
  1.  .S RDT=RPRDT_$C(29)_RPRDT
  1.  .S GBL=GLOBAL_$C(29)_GLOBAL
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,RDT,GBL)
  1.  .K CPT,EDT,RDT,GBL
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,RPRDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,RPRDT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RPRDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RPRDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RPRDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RPRDT,REFGLOB)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"RPR"))!$D(@GLOB@("HIVCHK",BKMDFN,"RPRREF")) S @TOTPTS=@TOTPTS+1
  1.  Q
  1. CRC ; EP - Colorectal Cancer Screen
  1.  ;Patients who needed a CRC in the 10 years prior to end date of the report.
  1.  ;Defined as including patients:
  1.  ; 1) Greater than or equal to 50 years of age
  1.  ; 2) No CRC diagnosis ever (DX.18)
  1.  ; 3) No history of a total Colectomy (P.06)
  1.  ;
  1.  N CRCDT,GLOBAL,GLOBAL1,REFGLOB,CPTTAX,ICDTAX,CPTTAX1,PRCTAX,PRCTAX1,PRCTAX2
  1.  N CPTTAX2,CPTTAX3,CPTTAX4,CPTTAX5,LOINTAX,SITETAX,TOTPTS,BKMDFN,AGEDT
  1.  S CRCDT=$$FMADD^XLFDT(EDATE,-3650),AGEDT=$$FMADD^XLFDT(EDATE,-365)\1
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""NOCRC"",VSTDT,TEST)"
  1.  S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",DFN,""CRC"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""CRCREF"",VSTDT,TEST)"
  1.  S CPTTAX="BGP COLORECTAL CANCER CPTS"
  1.  S ICDTAX="BGP COLORECTAL CANCER DXS"
  1.  S CPTTAX1="BGP TOTAL CHOLECTOMY CPTS"
  1.  S PRCTAX="BGP TOTAL CHOLECTOMY PROCS"
  1.  S PRCTAX1="BGP SIG PROCS"
  1.  S PRCTAX2="BGP COLO PROCS"
  1.  S CPTTAX2="BGP COLO CPTS"
  1.  S CPTTAX3="BGP FOBT CPTS"
  1.  S CPTTAX4="BTPW SIGMOID CPTS"
  1.  S CPTTAX5="BGP BE CPTS"
  1.  S LOINTAX="BGP FOBT LOINC CODES"
  1.  S SITETAX="BGP GPRA FOB TESTS"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CRCCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .; Age at beginning of reporting period
  1.  .I $$AGE^BQIAGE(BKMDFN,AGEDT)<50 Q
  1.  .D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CRCDT,GLOBAL)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CRCDT,GLOBAL)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,CRCDT,GLOBAL)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
  1.  .D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CRCDT,GLOBAL)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
  1.  .; Patient needs CRC
  1.  .S @TOTPTS=@TOTPTS+1
  1.  .; Check CRC Screens
  1.  .; *** if only checking for presence of Screening or Refusal, same check ***
  1.  .; *** as for NOCRC above can be applied here.                           ***
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX2,EDATE,CRCDT,GLOBAL1)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX3,EDATE,CRCDT,GLOBAL1)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX4,EDATE,CRCDT,GLOBAL1)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX5,EDATE,CRCDT,GLOBAL1)
  1.  .N CPT,EDT,CDT,GBL
  1.  .S CPT=CPTTAX2_$C(29)_CPTTAX3_$C(29)_CPTTAX4_$C(29)_CPTTAX5
  1.  .S EDT=EDATE_$C(29)_EDATE_$C(29)_EDATE_$C(29)_EDATE
  1.  .S CDT=CRCDT_$C(29)_CRCDT_$C(29)_CRCDT_$C(29)_CRCDT
  1.  .S GBL=GLOBAL1_$C(29)_GLOBAL1_$C(29)_GLOBAL1_$C(29)_GLOBAL1
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,CDT,GBL)
  1.  .K CPT,EDT,CDT,GBL
  1.  .D PRCTAX^BKMIXX1(BKMDFN,PRCTAX1,EDATE,CRCDT,GLOBAL1)
  1.  .D PRCTAX^BKMIXX1(BKMDFN,PRCTAX2,EDATE,CRCDT,GLOBAL1)
  1.  .D ICDTAX^BKMIXX1(BKMDFN,"BGP COLO DXS",EDATE,CRCDT,GLOBAL1)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CRCDT,GLOBAL1)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CRCDT,GLOBAL1)
  1.  .; May get taxonomy for hard coded values for Flex Sig, Double Contrast Barium Enema, Colonoscopy and FOBT
  1.  .; If not these will need to be dealt with.
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CRCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CRCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX2,EDATE,CRCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX3,EDATE,CRCDT,REFGLOB)
  1.  Q
  1. HEPC ; EP - Hepatitis C Screen Baseline
  1.  ;Total # of patients with a Hepatitis C Screen (T.13; T.14)
  1.  ;baseline completed or refused ever.
  1.  ;
  1.  N HEPCDT,GLOBAL,REFGLOB,CPTTAX,LOINTAX,SITETAX,CPTTAX1,LOINTAX1
  1.  N SITETAX1,TOTPTS,BKMDFN,RHEPCDT
  1.  S HEPCDT=""
  1.  ; Refused in past year
  1.  S RHEPCDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""HEPC"",VSTDT,TEST)"
  1.  S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""HEPCREF"",VSTDT,TEST)"
  1.  S CPTTAX="BKM HEP C SCREEN TESTS CPTS"
  1.  S LOINTAX="BKM HEP C SCREEN LOINC CODES"
  1.  S SITETAX="BKM HEP C SCREENING TAX"
  1.  S CPTTAX1="BKM HEP C CONFIRM TESTS CPTS"
  1.  S LOINTAX1="BKM HEP C CONFIRM LOINC CODES"
  1.  S SITETAX1="BKM HEP C CONFIRMATORY TAX"
  1.  S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""HEPCCNT"")"
  1.  S BKMDFN=0,@TOTPTS=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HEPCDT,GLOBAL)
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HEPCDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HEPCDT,GLOBAL)
  1.  .;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HEPCDT,GLOBAL)
  1.  .N CPT,EDT,HDT,GBL
  1.  .S CPT=CPTTAX_$C(29)_CPTTAX1
  1.  .S EDT=EDATE_$C(29)_EDATE
  1.  .S HDT=HEPCDT_$C(29)_HEPCDT
  1.  .S GBL=GLOBAL_$C(29)_GLOBAL
  1.  .D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
  1.  .K CPT,EDT,HDT,GBL
  1.  .D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HEPCDT,GLOBAL)
  1.  .D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HEPCDT,GLOBAL)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX,EDATE,RHEPCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RHEPCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RHEPCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX1,EDATE,RHEPCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RHEPCDT,REFGLOB)
  1.  .D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RHEPCDT,REFGLOB)
  1.  .I $D(@GLOB@("HIVCHK",BKMDFN,"HEPC"))!$D(@GLOB@("HIVCHK",BKMDFN,"HEPCREF")) S @TOTPTS=@TOTPTS+1
  1.  Q