BKMQQCR1 ;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
CD4CHK ; EP - CD4 algorithm
N HIVDT,HIVDT12,SITETAX,SITETAX1,LOINTAX,LOINTAX1,CPTTAX,CPTTAX1,GLOBAL,GLOBAL2,GLOBAL3
N TOTPTS,BKMDFN,TREF
S HIVDT=$$FMADD^XLFDT(EDATE,-122) ;***
S HIVDT12=$$FMADD^XLFDT(EDATE,-365) ; CD4 last 12 months for PCP and MAC Prophylaxis
S TREF=$NA(^TMP("BKMTAX",UID)) K @TREF
S SITETAX="BGP CD4 TAX"
S SITETAX1="BKMV CD4 ABS TESTS TAX"
S LOINTAX="BGP CD4 LOINC CODES"
S LOINTAX1="BKMV CD4 ABS LOINC CODES"
S CPTTAX="BGP CD4 CPTS"
S CPTTAX1="BKMV CD4 ABS CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ALL"",VSTDT,TEST)"
S GLOBAL2=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS"",VSTDT,TEST)"
S GLOBAL3=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS12"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CD4PTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.N CPT,EDT,HDT,GBL
.S CPT=CPTTAX_$C(29)_CPTTAX1_$C(29)_CPTTAX1
.S EDT=EDATE_$C(29)_EDATE_$C(29)_EDATE
.S HDT=HIVDT_$C(29)_HIVDT_$C(29)_HIVDT12
.S GBL=GLOBAL_$C(29)_GLOBAL2_$C(29)_GLOBAL3
.D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
.K CPT,EDT,HDT,GBL
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HIVDT,GLOBAL)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT,GLOBAL2)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT12,GLOBAL3)
.;F TAX=LOINCTAX,SITETAX D BLDTAX^BKMIXX5(TAX,.TREF)
.;D LAB^BKMIXX6(BKMDFN,.TREF,EDATE,HIVDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HIVDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HIVDT,GLOBAL)
.;
.D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT,GLOBAL2)
.D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT,GLOBAL2)
.;
.D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT12,GLOBAL3)
.D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT12,GLOBAL3)
.I $D(@GLOB@("HIVCHK",BKMDFN,"CD4ALL"))!$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS")) S @TOTPTS=@TOTPTS+1
Q
VRLLD ; EP - Viral Load Check
N VRLDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,TOTPTS,BKMDFN
S VRLDT=$$FMADD^XLFDT(EDATE,-122) ;***
S SITETAX="BGP HIV VIRAL LOAD TAX"
S LOINTAX="BGP VIRAL LOAD LOINC CODES"
S CPTTAX="BGP HIV VIRAL LOAD CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""VRL"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""VRLPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,VRLDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,VRLDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VRLDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"VRL")) S @TOTPTS=@TOTPTS+1
Q
RPR ; EP - Rapid Plasma Reagin tests
N RPRDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
N SITETAX1,LOINTAX1,CPTTAX1
S RPRDT=$$FMADD^XLFDT(EDATE,-365)
S SITETAX="BKM RPR TAX"
S LOINTAX="BKM RPR LOINC CODES"
S CPTTAX="BKM RPR CPTS"
S SITETAX1="BKM FTA-ABS TEST TAX"
S LOINTAX1="BKM FTA-ABS LOINC CODES"
S CPTTAX1="BKM FTA-ABS CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""RPR"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""RPRREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""RPRPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,RPRDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,RPRDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,RPRDT,GLOBAL)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,RPRDT,GLOBAL)
.N CPT,EDT,RDT,GBL
.S CPT=CPTTAX_$C(29)_CPTTAX1
.S EDT=EDATE_$C(29)_EDATE
.S RDT=RPRDT_$C(29)_RPRDT
.S GBL=GLOBAL_$C(29)_GLOBAL
.D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,RDT,GBL)
.K CPT,EDT,RDT,GBL
.D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,RPRDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,RPRDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RPRDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RPRDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RPRDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RPRDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"RPR"))!$D(@GLOB@("HIVCHK",BKMDFN,"RPRREF")) S @TOTPTS=@TOTPTS+1
Q
CRC ; EP - Colorectal Cancer Screen
;Patients who needed a CRC in the 10 years prior to end date of the report.
;Defined as including patients:
; 1) Greater than or equal to 50 years of age
; 2) No CRC diagnosis ever (DX.18)
; 3) No history of a total Colectomy (P.06)
;
N CRCDT,GLOBAL,GLOBAL1,REFGLOB,CPTTAX,ICDTAX,CPTTAX1,PRCTAX,PRCTAX1,PRCTAX2
N CPTTAX2,CPTTAX3,CPTTAX4,CPTTAX5,LOINTAX,SITETAX,TOTPTS,BKMDFN,AGEDT
S CRCDT=$$FMADD^XLFDT(EDATE,-3650),AGEDT=$$FMADD^XLFDT(EDATE,-365)\1
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""NOCRC"",VSTDT,TEST)"
S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",DFN,""CRC"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""CRCREF"",VSTDT,TEST)"
S CPTTAX="BGP COLORECTAL CANCER CPTS"
S ICDTAX="BGP COLORECTAL CANCER DXS"
S CPTTAX1="BGP TOTAL CHOLECTOMY CPTS"
S PRCTAX="BGP TOTAL CHOLECTOMY PROCS"
S PRCTAX1="BGP SIG PROCS"
S PRCTAX2="BGP COLO PROCS"
S CPTTAX2="BGP COLO CPTS"
S CPTTAX3="BGP FOBT CPTS"
S CPTTAX4="BTPW SIGMOID CPTS"
S CPTTAX5="BGP BE CPTS"
S LOINTAX="BGP FOBT LOINC CODES"
S SITETAX="BGP GPRA FOB TESTS"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""CRCCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.; Age at beginning of reporting period
.I $$AGE^BQIAGE(BKMDFN,AGEDT)<50 Q
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CRCDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CRCDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,CRCDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CRCDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"NOCRC")) Q
.; Patient needs CRC
.S @TOTPTS=@TOTPTS+1
.; Check CRC Screens
.; *** if only checking for presence of Screening or Refusal, same check ***
.; *** as for NOCRC above can be applied here. ***
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX2,EDATE,CRCDT,GLOBAL1)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX3,EDATE,CRCDT,GLOBAL1)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX4,EDATE,CRCDT,GLOBAL1)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX5,EDATE,CRCDT,GLOBAL1)
.N CPT,EDT,CDT,GBL
.S CPT=CPTTAX2_$C(29)_CPTTAX3_$C(29)_CPTTAX4_$C(29)_CPTTAX5
.S EDT=EDATE_$C(29)_EDATE_$C(29)_EDATE_$C(29)_EDATE
.S CDT=CRCDT_$C(29)_CRCDT_$C(29)_CRCDT_$C(29)_CRCDT
.S GBL=GLOBAL1_$C(29)_GLOBAL1_$C(29)_GLOBAL1_$C(29)_GLOBAL1
.D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,CDT,GBL)
.K CPT,EDT,CDT,GBL
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX1,EDATE,CRCDT,GLOBAL1)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX2,EDATE,CRCDT,GLOBAL1)
.D ICDTAX^BKMIXX1(BKMDFN,"BGP COLO DXS",EDATE,CRCDT,GLOBAL1)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CRCDT,GLOBAL1)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CRCDT,GLOBAL1)
.; May get taxonomy for hard coded values for Flex Sig, Double Contrast Barium Enema, Colonoscopy and FOBT
.; If not these will need to be dealt with.
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CRCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CRCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX2,EDATE,CRCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX3,EDATE,CRCDT,REFGLOB)
Q
HEPC ; EP - Hepatitis C Screen Baseline
;Total # of patients with a Hepatitis C Screen (T.13; T.14)
;baseline completed or refused ever.
;
N HEPCDT,GLOBAL,REFGLOB,CPTTAX,LOINTAX,SITETAX,CPTTAX1,LOINTAX1
N SITETAX1,TOTPTS,BKMDFN,RHEPCDT
S HEPCDT=""
; Refused in past year
S RHEPCDT=$$FMADD^XLFDT(EDATE,-365)
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",DFN,""HEPC"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",DFN,""HEPCREF"",VSTDT,TEST)"
S CPTTAX="BKM HEP C SCREEN TESTS CPTS"
S LOINTAX="BKM HEP C SCREEN LOINC CODES"
S SITETAX="BKM HEP C SCREENING TAX"
S CPTTAX1="BKM HEP C CONFIRM TESTS CPTS"
S LOINTAX1="BKM HEP C CONFIRM LOINC CODES"
S SITETAX1="BKM HEP C CONFIRMATORY TAX"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""HEPCCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HEPCDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HEPCDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HEPCDT,GLOBAL)
.;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HEPCDT,GLOBAL)
.N CPT,EDT,HDT,GBL
.S CPT=CPTTAX_$C(29)_CPTTAX1
.S EDT=EDATE_$C(29)_EDATE
.S HDT=HEPCDT_$C(29)_HEPCDT
.S GBL=GLOBAL_$C(29)_GLOBAL
.D CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
.K CPT,EDT,HDT,GBL
.D LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HEPCDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HEPCDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX,EDATE,RHEPCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RHEPCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RHEPCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX1,EDATE,RHEPCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RHEPCDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RHEPCDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"HEPC"))!$D(@GLOB@("HIVCHK",BKMDFN,"HEPCREF")) S @TOTPTS=@TOTPTS+1
Q
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
+2 ; Quality of Care Audit Report
+3 QUIT
CD4CHK ; EP - CD4 algorithm
+1 NEW HIVDT,HIVDT12,SITETAX,SITETAX1,LOINTAX,LOINTAX1,CPTTAX,CPTTAX1,GLOBAL,GLOBAL2,GLOBAL3
+2 NEW TOTPTS,BKMDFN,TREF
+3 ;***
SET HIVDT=$$FMADD^XLFDT(EDATE,-122)
+4 ; CD4 last 12 months for PCP and MAC Prophylaxis
SET HIVDT12=$$FMADD^XLFDT(EDATE,-365)
+5 SET TREF=$NAME(^TMP("BKMTAX",UID))
KILL @TREF
+6 SET SITETAX="BGP CD4 TAX"
+7 SET SITETAX1="BKMV CD4 ABS TESTS TAX"
+8 SET LOINTAX="BGP CD4 LOINC CODES"
+9 SET LOINTAX1="BKMV CD4 ABS LOINC CODES"
+10 SET CPTTAX="BGP CD4 CPTS"
+11 SET CPTTAX1="BKMV CD4 ABS CPTS"
+12 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ALL"",VSTDT,TEST)"
+13 SET GLOBAL2=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS"",VSTDT,TEST)"
+14 SET GLOBAL3=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""CD4ABS12"",VSTDT,TEST)"
+15 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""CD4PTCNT"")"
+16 SET BKMDFN=0
SET @TOTPTS=0
+17 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+18 NEW CPT,EDT,HDT,GBL
+19 SET CPT=CPTTAX_$CHAR(29)_CPTTAX1_$CHAR(29)_CPTTAX1
+20 SET EDT=EDATE_$CHAR(29)_EDATE_$CHAR(29)_EDATE
+21 SET HDT=HIVDT_$CHAR(29)_HIVDT_$CHAR(29)_HIVDT12
+22 SET GBL=GLOBAL_$CHAR(29)_GLOBAL2_$CHAR(29)_GLOBAL3
+23 DO CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
+24 KILL CPT,EDT,HDT,GBL
+25 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HIVDT,GLOBAL)
+26 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT,GLOBAL2)
+27 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HIVDT12,GLOBAL3)
+28 ;F TAX=LOINCTAX,SITETAX D BLDTAX^BKMIXX5(TAX,.TREF)
+29 ;D LAB^BKMIXX6(BKMDFN,.TREF,EDATE,HIVDT,GLOBAL)
+30 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HIVDT,GLOBAL)
+31 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HIVDT,GLOBAL)
+32 ;
+33 DO LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT,GLOBAL2)
+34 DO LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT,GLOBAL2)
+35 ;
+36 DO LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HIVDT12,GLOBAL3)
+37 DO LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HIVDT12,GLOBAL3)
+38 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ALL"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ABS"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+39 QUIT
VRLLD ; EP - Viral Load Check
+1 NEW VRLDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,TOTPTS,BKMDFN
+2 ;***
SET VRLDT=$$FMADD^XLFDT(EDATE,-122)
+3 SET SITETAX="BGP HIV VIRAL LOAD TAX"
+4 SET LOINTAX="BGP VIRAL LOAD LOINC CODES"
+5 SET CPTTAX="BGP HIV VIRAL LOAD CPTS"
+6 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""VRL"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""VRLPTCNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,VRLDT,GLOBAL)
+11 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,VRLDT,GLOBAL)
+12 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,VRLDT,GLOBAL)
+13 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"VRL"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+14 QUIT
RPR ; EP - Rapid Plasma Reagin tests
+1 NEW RPRDT,SITETAX,LOINTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
+2 NEW SITETAX1,LOINTAX1,CPTTAX1
+3 SET RPRDT=$$FMADD^XLFDT(EDATE,-365)
+4 SET SITETAX="BKM RPR TAX"
+5 SET LOINTAX="BKM RPR LOINC CODES"
+6 SET CPTTAX="BKM RPR CPTS"
+7 SET SITETAX1="BKM FTA-ABS TEST TAX"
+8 SET LOINTAX1="BKM FTA-ABS LOINC CODES"
+9 SET CPTTAX1="BKM FTA-ABS CPTS"
+10 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""RPR"",VSTDT,TEST)"
+11 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""RPRREF"",VSTDT,TEST)"
+12 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""RPRPTCNT"")"
+13 SET BKMDFN=0
SET @TOTPTS=0
+14 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+15 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,RPRDT,GLOBAL)
+16 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,RPRDT,GLOBAL)
+17 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,RPRDT,GLOBAL)
+18 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,RPRDT,GLOBAL)
+19 NEW CPT,EDT,RDT,GBL
+20 SET CPT=CPTTAX_$CHAR(29)_CPTTAX1
+21 SET EDT=EDATE_$CHAR(29)_EDATE
+22 SET RDT=RPRDT_$CHAR(29)_RPRDT
+23 SET GBL=GLOBAL_$CHAR(29)_GLOBAL
+24 DO CPTTAX^BKMIXX(BKMDFN,CPT,EDT,RDT,GBL)
+25 KILL CPT,EDT,RDT,GBL
+26 DO LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,RPRDT,GLOBAL)
+27 DO LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,RPRDT,GLOBAL)
+28 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RPRDT,REFGLOB)
+29 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RPRDT,REFGLOB)
+30 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RPRDT,REFGLOB)
+31 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RPRDT,REFGLOB)
+32 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"RPR"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"RPRREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+33 QUIT
CRC ; EP - Colorectal Cancer Screen
+1 ;Patients who needed a CRC in the 10 years prior to end date of the report.
+2 ;Defined as including patients:
+3 ; 1) Greater than or equal to 50 years of age
+4 ; 2) No CRC diagnosis ever (DX.18)
+5 ; 3) No history of a total Colectomy (P.06)
+6 ;
+7 NEW CRCDT,GLOBAL,GLOBAL1,REFGLOB,CPTTAX,ICDTAX,CPTTAX1,PRCTAX,PRCTAX1,PRCTAX2
+8 NEW CPTTAX2,CPTTAX3,CPTTAX4,CPTTAX5,LOINTAX,SITETAX,TOTPTS,BKMDFN,AGEDT
+9 SET CRCDT=$$FMADD^XLFDT(EDATE,-3650)
SET AGEDT=$$FMADD^XLFDT(EDATE,-365)\1
+10 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""NOCRC"",VSTDT,TEST)"
+11 SET GLOBAL1=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""CRC"",VSTDT,TEST)"
+12 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""CRCREF"",VSTDT,TEST)"
+13 SET CPTTAX="BGP COLORECTAL CANCER CPTS"
+14 SET ICDTAX="BGP COLORECTAL CANCER DXS"
+15 SET CPTTAX1="BGP TOTAL CHOLECTOMY CPTS"
+16 SET PRCTAX="BGP TOTAL CHOLECTOMY PROCS"
+17 SET PRCTAX1="BGP SIG PROCS"
+18 SET PRCTAX2="BGP COLO PROCS"
+19 SET CPTTAX2="BGP COLO CPTS"
+20 SET CPTTAX3="BGP FOBT CPTS"
+21 SET CPTTAX4="BTPW SIGMOID CPTS"
+22 SET CPTTAX5="BGP BE CPTS"
+23 SET LOINTAX="BGP FOBT LOINC CODES"
+24 SET SITETAX="BGP GPRA FOB TESTS"
+25 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""CRCCNT"")"
+26 SET BKMDFN=0
SET @TOTPTS=0
+27 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+28 ; Age at beginning of reporting period
+29 IF $$AGE^BQIAGE(BKMDFN,AGEDT)<50
QUIT
+30 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,CRCDT,GLOBAL)
+31 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"NOCRC"))
QUIT
+32 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,CRCDT,GLOBAL)
+33 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"NOCRC"))
QUIT
+34 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,CRCDT,GLOBAL)
+35 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"NOCRC"))
QUIT
+36 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,CRCDT,GLOBAL)
+37 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"NOCRC"))
QUIT
+38 ; Patient needs CRC
+39 SET @TOTPTS=@TOTPTS+1
+40 ; Check CRC Screens
+41 ; *** if only checking for presence of Screening or Refusal, same check ***
+42 ; *** as for NOCRC above can be applied here. ***
+43 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX2,EDATE,CRCDT,GLOBAL1)
+44 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX3,EDATE,CRCDT,GLOBAL1)
+45 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX4,EDATE,CRCDT,GLOBAL1)
+46 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX5,EDATE,CRCDT,GLOBAL1)
+47 NEW CPT,EDT,CDT,GBL
+48 SET CPT=CPTTAX2_$CHAR(29)_CPTTAX3_$CHAR(29)_CPTTAX4_$CHAR(29)_CPTTAX5
+49 SET EDT=EDATE_$CHAR(29)_EDATE_$CHAR(29)_EDATE_$CHAR(29)_EDATE
+50 SET CDT=CRCDT_$CHAR(29)_CRCDT_$CHAR(29)_CRCDT_$CHAR(29)_CRCDT
+51 SET GBL=GLOBAL1_$CHAR(29)_GLOBAL1_$CHAR(29)_GLOBAL1_$CHAR(29)_GLOBAL1
+52 DO CPTTAX^BKMIXX(BKMDFN,CPT,EDT,CDT,GBL)
+53 KILL CPT,EDT,CDT,GBL
+54 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX1,EDATE,CRCDT,GLOBAL1)
+55 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX2,EDATE,CRCDT,GLOBAL1)
+56 DO ICDTAX^BKMIXX1(BKMDFN,"BGP COLO DXS",EDATE,CRCDT,GLOBAL1)
+57 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,CRCDT,GLOBAL1)
+58 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,CRCDT,GLOBAL1)
+59 ; May get taxonomy for hard coded values for Flex Sig, Double Contrast Barium Enema, Colonoscopy and FOBT
+60 ; If not these will need to be dealt with.
+61 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,CRCDT,REFGLOB)
+62 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,CRCDT,REFGLOB)
+63 DO REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX2,EDATE,CRCDT,REFGLOB)
+64 DO REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX3,EDATE,CRCDT,REFGLOB)
End DoDot:1
+65 QUIT
HEPC ; EP - Hepatitis C Screen Baseline
+1 ;Total # of patients with a Hepatitis C Screen (T.13; T.14)
+2 ;baseline completed or refused ever.
+3 ;
+4 NEW HEPCDT,GLOBAL,REFGLOB,CPTTAX,LOINTAX,SITETAX,CPTTAX1,LOINTAX1
+5 NEW SITETAX1,TOTPTS,BKMDFN,RHEPCDT
+6 SET HEPCDT=""
+7 ; Refused in past year
+8 SET RHEPCDT=$$FMADD^XLFDT(EDATE,-365)
+9 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""HEPC"",VSTDT,TEST)"
+10 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",DFN,""HEPCREF"",VSTDT,TEST)"
+11 SET CPTTAX="BKM HEP C SCREEN TESTS CPTS"
+12 SET LOINTAX="BKM HEP C SCREEN LOINC CODES"
+13 SET SITETAX="BKM HEP C SCREENING TAX"
+14 SET CPTTAX1="BKM HEP C CONFIRM TESTS CPTS"
+15 SET LOINTAX1="BKM HEP C CONFIRM LOINC CODES"
+16 SET SITETAX1="BKM HEP C CONFIRMATORY TAX"
+17 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""HEPCCNT"")"
+18 SET BKMDFN=0
SET @TOTPTS=0
+19 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+20 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,HEPCDT,GLOBAL)
+21 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,HEPCDT,GLOBAL)
+22 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,HEPCDT,GLOBAL)
+23 ;D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HEPCDT,GLOBAL)
+24 NEW CPT,EDT,HDT,GBL
+25 SET CPT=CPTTAX_$CHAR(29)_CPTTAX1
+26 SET EDT=EDATE_$CHAR(29)_EDATE
+27 SET HDT=HEPCDT_$CHAR(29)_HEPCDT
+28 SET GBL=GLOBAL_$CHAR(29)_GLOBAL
+29 DO CPTTAX^BKMIXX(BKMDFN,CPT,EDT,HDT,GBL)
+30 KILL CPT,EDT,HDT,GBL
+31 DO LOINC^BKMIXX(BKMDFN,LOINTAX1,EDATE,HEPCDT,GLOBAL)
+32 DO LABTAX^BKMIXX(BKMDFN,SITETAX1,EDATE,HEPCDT,GLOBAL)
+33 DO REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX,EDATE,RHEPCDT,REFGLOB)
+34 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,RHEPCDT,REFGLOB)
+35 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,RHEPCDT,REFGLOB)
+36 DO REFUSAL^BKMIXX2(BKMDFN,81,CPTTAX1,EDATE,RHEPCDT,REFGLOB)
+37 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX1,EDATE,RHEPCDT,REFGLOB)
+38 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX1,EDATE,RHEPCDT,REFGLOB)
+39 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"HEPC"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"HEPCREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+40 QUIT
