BKMQQCR3 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
; Quality of Care Audit Report
Q
TETSTAT ; EP - Tetanus Status
N TETDT,TETDT1,CVXTAX,ICDTAX,PRCTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
S TETDT=$$FMADD^XLFDT(EDATE,-3650)
S TETDT1=$$FMADD^XLFDT(EDATE,-365)
S CVXTAX="BKM TETANUS IZ CVX CODES"
S ICDTAX="BKM TETANUS IZ DXS"
S PRCTAX="BKM TETANUS IZ PROCEDURES"
S CPTTAX="BKM TETANUS IZ CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TET"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""TETREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""TETPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TETDT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TETDT,GLOBAL)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,TETDT,GLOBAL)
.D CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,TETDT,GLOBAL)
.; Refusals are only counted from last year.
.D REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,TETDT1,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"TET"))!$D(@GLOB@("HIVCHK",BKMDFN,"TETREF")) S @TOTPTS=@TOTPTS+1 Q
Q
EYEEXAM ; EP - Eye Exam Status
N EEXAMDT,CPTTAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN,CLINIC,PROVIDER
S EEXAMDT=$$FMADD^XLFDT(EDATE,-365)
S CPTTAX="BGP DM EYE EXAM CPTS"
S CPTTAX1="BGP RETINAL EXAM CPTS"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""EYE"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""EYEREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""EYEPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,EEXAMDT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,EEXAMDT,GLOBAL)
.F CLINIC=17,18,64,"A2" D CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,EEXAMDT,GLOBAL)
.F PROVIDER=79,24,"08" D PRVTAX^BKMIXX2(BKMDFN,PROVIDER,EDATE,EEXAMDT,GLOBAL)
.D EXAMTAX^BKMIXX1(BKMDFN,"03",EDATE,EEXAMDT,GLOBAL)
.;D PROCTAX^BKMIXX2(BKMDFN,95.02,EDATE,EEXAMDT,GLOBAL)
.D PRCTAX^BKMIXX1(BKMDFN,"BQI EYE EXAM PROCS",EDATE,EEXAMDT,GLOBAL)
.;D POVTAX^BKMIXX2(BKMDFN,"V72.0",EDATE,EEXAMDT,GLOBAL)
.D ICDTAX^BKMIXX1(BKMDFN,"BQI EYE EXAM DXS",EDATE,EEXAMDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"EYE")) S @TOTPTS=@TOTPTS+1 Q
.D REFUSAL^BKMIXX2(BKMDFN,9999999.15,"03",EDATE,EEXAMDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"EYEREF")) S @TOTPTS=@TOTPTS+1
Q
DENTEXAM ; EP - Dental Exam Status
N DEXAMDT,ICDTAX,ADATAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN
S DEXAMDT=$$FMADD^XLFDT(EDATE,-365)
S ICDTAX="BKM DENTAL EXAMINATION"
S ADATAX="BGP DENTAL EXAM DENTAL CODE"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""DENT"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""DENTREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""DENTPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,DEXAMDT,GLOBAL)
.D ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,DEXAMDT,GLOBAL)
.D EXAMTAX^BKMIXX1(BKMDFN,"30",EDATE,DEXAMDT,GLOBAL)
.I $D(@GLOB@("HIVCHK",BKMDFN,"DENT")) S @TOTPTS=@TOTPTS+1 Q
.D REFUSAL^BKMIXX2(BKMDFN,9999999.15,"30",EDATE,DEXAMDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"DENTREF")) S @TOTPTS=@TOTPTS+1
Q
PAP ; EP - Pap Smear Status
N PAPDT,HISTDT,CPTTAX,ICDTAX,PRCTAX,LOINTAX,SITETAX,CPTTAX1,ICDTAX1
N GLOBAL,GLOBAL1,REFGLOB,TOTPTS,SEX,AGE,BKMDFN,PRCTAX1
S HISTDT=""
S CPTTAX1="BGP HYSTERECTOMY CPTS"
S PRCTAX1="BGP HYSTERECTOMY PROCEDURES"
S ICDTAX1="BGP HYSTERECTOMY DXS"
S GLOBAL1=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""HIST"",VSTDT,TEST)"
S PAPDT=$$FMADD^XLFDT(EDATE,-365)
S CPTTAX="BGP CPT PAP"
S ICDTAX="BGP PAP SMEAR DXS"
S PRCTAX="BQI PAP PROCEDURES"
S LOINTAX="BGP PAP LOINC CODES"
S SITETAX="BGP PAP SMEAR TAX"
S GLOBAL=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PAP"",VSTDT,TEST)"
S REFGLOB=$P(GLOB,")")_",""HIVCHK"",BKMDFN,""PAPREF"",VSTDT,TEST)"
S TOTPTS=$P(GLOB,")")_",""HIVCHK"",""PAPPTCNT"")"
S BKMDFN=0,@TOTPTS=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.S SEX=$$GET1^DIQ(2,BKMDFN,.02,"I")
.;Only interested in female patients
.I SEX'="F" Q
.S AGE=$$AGE^BKMIMRP1(BKMDFN)
.;Only interested in patients between 19 and 64
.I AGE<19!(AGE>64)!(AGE'?1.N) Q
.;Only interested in patients with no hysterectomy
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,HISTDT,GLOBAL1)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HISTDT,GLOBAL1)
.;D POVTAX^BKMIXX2(BKMDFN,618.5,EDATE,HISTDT,GLOBAL1)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX1,EDATE,HISTDT,GLOBAL1)
.I $D(@GLOB@("HIVCHK",BKMDFN,"HIST")) Q
.D ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,PAPDT,GLOBAL)
.D CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,PAPDT,GLOBAL)
.D PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,PAPDT,GLOBAL)
.D LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,PAPDT,GLOBAL)
.D LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,PAPDT,GLOBAL)
.D WHTAX^BKMIXX2(BKMDFN,"PAP SMEAR",EDATE,PAPDT,GLOBAL)
.D REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,PAPDT,REFGLOB)
.D REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,PAPDT,REFGLOB)
.I $D(@GLOB@("HIVCHK",BKMDFN,"PAP"))!$D(@GLOB@("HIVCHK",BKMDFN,"PAPREF")) S @TOTPTS=@TOTPTS+1
Q
BKMQQCR3 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
+1 ;;2.2;HIV MANAGEMENT SYSTEM;;Apr 01, 2015;Build 40
+2 ; Quality of Care Audit Report
+3 QUIT
TETSTAT ; EP - Tetanus Status
+1 NEW TETDT,TETDT1,CVXTAX,ICDTAX,PRCTAX,CPTTAX,GLOBAL,GLOBAL2,REFGLOB,TOTPTS,BKMDFN
+2 SET TETDT=$$FMADD^XLFDT(EDATE,-3650)
+3 SET TETDT1=$$FMADD^XLFDT(EDATE,-365)
+4 SET CVXTAX="BKM TETANUS IZ CVX CODES"
+5 SET ICDTAX="BKM TETANUS IZ DXS"
+6 SET PRCTAX="BKM TETANUS IZ PROCEDURES"
+7 SET CPTTAX="BKM TETANUS IZ CPTS"
+8 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TET"",VSTDT,TEST)"
+9 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""TETREF"",VSTDT,TEST)"
+10 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""TETPTCNT"")"
+11 SET BKMDFN=0
SET @TOTPTS=0
+12 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+13 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,TETDT,GLOBAL)
+14 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,TETDT,GLOBAL)
+15 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,TETDT,GLOBAL)
+16 DO CVXTAX^BKMIXX1(BKMDFN,CVXTAX,EDATE,TETDT,GLOBAL)
+17 ; Refusals are only counted from last year.
+18 DO REFUSAL^BKMIXX2(BKMDFN,9999999.14,CVXTAX,EDATE,TETDT1,REFGLOB)
+19 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"TET"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"TETREF"))
SET @TOTPTS=@TOTPTS+1
QUIT
End DoDot:1
+20 QUIT
EYEEXAM ; EP - Eye Exam Status
+1 NEW EEXAMDT,CPTTAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN,CLINIC,PROVIDER
+2 SET EEXAMDT=$$FMADD^XLFDT(EDATE,-365)
+3 SET CPTTAX="BGP DM EYE EXAM CPTS"
+4 SET CPTTAX1="BGP RETINAL EXAM CPTS"
+5 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""EYE"",VSTDT,TEST)"
+6 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""EYEREF"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""EYEPTCNT"")"
+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,EEXAMDT,GLOBAL)
+11 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,EEXAMDT,GLOBAL)
+12 FOR CLINIC=17,18,64,"A2"
DO CLNTAX^BKMIXX2(BKMDFN,CLINIC,EDATE,EEXAMDT,GLOBAL)
+13 FOR PROVIDER=79,24,"08"
DO PRVTAX^BKMIXX2(BKMDFN,PROVIDER,EDATE,EEXAMDT,GLOBAL)
+14 DO EXAMTAX^BKMIXX1(BKMDFN,"03",EDATE,EEXAMDT,GLOBAL)
+15 ;D PROCTAX^BKMIXX2(BKMDFN,95.02,EDATE,EEXAMDT,GLOBAL)
+16 DO PRCTAX^BKMIXX1(BKMDFN,"BQI EYE EXAM PROCS",EDATE,EEXAMDT,GLOBAL)
+17 ;D POVTAX^BKMIXX2(BKMDFN,"V72.0",EDATE,EEXAMDT,GLOBAL)
+18 DO ICDTAX^BKMIXX1(BKMDFN,"BQI EYE EXAM DXS",EDATE,EEXAMDT,GLOBAL)
+19 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"EYE"))
SET @TOTPTS=@TOTPTS+1
QUIT
+20 DO REFUSAL^BKMIXX2(BKMDFN,9999999.15,"03",EDATE,EEXAMDT,REFGLOB)
+21 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"EYEREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+22 QUIT
DENTEXAM ; EP - Dental Exam Status
+1 NEW DEXAMDT,ICDTAX,ADATAX,GLOBAL,REFGLOB,TOTPTS,BKMDFN
+2 SET DEXAMDT=$$FMADD^XLFDT(EDATE,-365)
+3 SET ICDTAX="BKM DENTAL EXAMINATION"
+4 SET ADATAX="BGP DENTAL EXAM DENTAL CODE"
+5 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""DENT"",VSTDT,TEST)"
+6 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""DENTREF"",VSTDT,TEST)"
+7 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""DENTPTCNT"")"
+8 SET BKMDFN=0
SET @TOTPTS=0
+9 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+10 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,DEXAMDT,GLOBAL)
+11 DO ADATAX^BKMIXX(BKMDFN,ADATAX,EDATE,DEXAMDT,GLOBAL)
+12 DO EXAMTAX^BKMIXX1(BKMDFN,"30",EDATE,DEXAMDT,GLOBAL)
+13 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"DENT"))
SET @TOTPTS=@TOTPTS+1
QUIT
+14 DO REFUSAL^BKMIXX2(BKMDFN,9999999.15,"30",EDATE,DEXAMDT,REFGLOB)
+15 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"DENTREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+16 QUIT
PAP ; EP - Pap Smear Status
+1 NEW PAPDT,HISTDT,CPTTAX,ICDTAX,PRCTAX,LOINTAX,SITETAX,CPTTAX1,ICDTAX1
+2 NEW GLOBAL,GLOBAL1,REFGLOB,TOTPTS,SEX,AGE,BKMDFN,PRCTAX1
+3 SET HISTDT=""
+4 SET CPTTAX1="BGP HYSTERECTOMY CPTS"
+5 SET PRCTAX1="BGP HYSTERECTOMY PROCEDURES"
+6 SET ICDTAX1="BGP HYSTERECTOMY DXS"
+7 SET GLOBAL1=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""HIST"",VSTDT,TEST)"
+8 SET PAPDT=$$FMADD^XLFDT(EDATE,-365)
+9 SET CPTTAX="BGP CPT PAP"
+10 SET ICDTAX="BGP PAP SMEAR DXS"
+11 SET PRCTAX="BQI PAP PROCEDURES"
+12 SET LOINTAX="BGP PAP LOINC CODES"
+13 SET SITETAX="BGP PAP SMEAR TAX"
+14 SET GLOBAL=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""PAP"",VSTDT,TEST)"
+15 SET REFGLOB=$PIECE(GLOB,")")_",""HIVCHK"",BKMDFN,""PAPREF"",VSTDT,TEST)"
+16 SET TOTPTS=$PIECE(GLOB,")")_",""HIVCHK"",""PAPPTCNT"")"
+17 SET BKMDFN=0
SET @TOTPTS=0
+18 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+19 SET SEX=$$GET1^DIQ(2,BKMDFN,.02,"I")
+20 ;Only interested in female patients
+21 IF SEX'="F"
QUIT
+22 SET AGE=$$AGE^BKMIMRP1(BKMDFN)
+23 ;Only interested in patients between 19 and 64
+24 IF AGE<19!(AGE>64)!(AGE'?1.N)
QUIT
+25 ;Only interested in patients with no hysterectomy
+26 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX1,EDATE,HISTDT,GLOBAL1)
+27 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX1,EDATE,HISTDT,GLOBAL1)
+28 ;D POVTAX^BKMIXX2(BKMDFN,618.5,EDATE,HISTDT,GLOBAL1)
+29 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX1,EDATE,HISTDT,GLOBAL1)
+30 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"HIST"))
QUIT
+31 DO ICDTAX^BKMIXX1(BKMDFN,ICDTAX,EDATE,PAPDT,GLOBAL)
+32 DO CPTTAX^BKMIXX(BKMDFN,CPTTAX,EDATE,PAPDT,GLOBAL)
+33 DO PRCTAX^BKMIXX1(BKMDFN,PRCTAX,EDATE,PAPDT,GLOBAL)
+34 DO LABTAX^BKMIXX(BKMDFN,SITETAX,EDATE,PAPDT,GLOBAL)
+35 DO LOINC^BKMIXX(BKMDFN,LOINTAX,EDATE,PAPDT,GLOBAL)
+36 DO WHTAX^BKMIXX2(BKMDFN,"PAP SMEAR",EDATE,PAPDT,GLOBAL)
+37 DO REFUSAL^BKMIXX2(BKMDFN,60,LOINTAX,EDATE,PAPDT,REFGLOB)
+38 DO REFUSAL^BKMIXX2(BKMDFN,60,SITETAX,EDATE,PAPDT,REFGLOB)
+39 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"PAP"))!$DATA(@GLOB@("HIVCHK",BKMDFN,"PAPREF"))
SET @TOTPTS=@TOTPTS+1
End DoDot:1
+40 QUIT
