BKMQQCR8 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 28 Apr 2005 3:44 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Quality of Care Audit Report
Q
PNEUMOC ; EP - Pneumo Calculation
N PNTOT,BKMDFN,TOT5YR,TOTB5YR,VSTDT,HVSTDT,CNT,CNT1,CNT2,PTOTAL
N REFVSTDT,PNDT5
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S PNTOT=$G(@GLOB@("HIVCHK","PNEUMOCNT"))
I PNTOT<1 Q
S PNDT5=$$FMADD^XLFDT(EDATE,-1825)
S BKMDFN=0,(TOTB5YR,TOT5YR)=0,(CNT,CNT1,CNT2)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.S VSTDT=0,TOT5YR=0,TOTB5YR=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"PNEUMO",VSTDT)) Q:VSTDT="" D
..I VSTDT>PNDT5 S TOT5YR=TOT5YR+1
..S TOTB5YR=TOTB5YR+1
.;We only want patients who have 1+ result in last 5 years, or 2+ results ever (including last 5 years)
.I TOT5YR>0 S CNT1=CNT1+1,CNT=CNT+1 Q
.I TOTB5YR>1 S CNT2=CNT2+1,CNT=CNT+1 Q
.; Also include any refusals in the past year.
.S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"PNEUMOREF",""),-1)
.I REFVSTDT]"",$$FMDIFF^XLFDT(REFVSTDT,EDATE,1)'>365 S CNT=CNT+1
I CNT=0 Q
S @GLOB@("PNEUMOT","TOTAL","CNT")=CNT
S @GLOB@("PNEUMOT","TOTAL","PERC")=CNT/PTOTAL*100
S @GLOB@("PNEUMOT","2B45YR","CNT")=CNT2
S @GLOB@("PNEUMOT","2B45YR","PERC")=CNT2/CNT*100
S @GLOB@("PNEUMOT","5YR","CNT")=CNT1
S @GLOB@("PNEUMOT","5YR","PERC")=CNT1/CNT*100
Q
TETCALC ; EP - Tetanus Calculation
N TETTOT,PTOTAL
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S TETTOT=$G(@GLOB@("HIVCHK","TETPTCNT"))
; NOTE: Refusals were checked earlier and are included in TETPTCNT.
I TETTOT=0 Q
S @GLOB@("TETT","TOTAL","CNT")=TETTOT
S @GLOB@("TETT","TOTAL","PERC")=TETTOT/PTOTAL*100
Q
EYECALC ; EP - Eye exam Calculation
N EYETOT,PTOTAL
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S EYETOT=$G(@GLOB@("HIVCHK","EYEPTCNT"))
; NOTE: Refusals were checked earlier and are included in EYEPTCNT.
I EYETOT=0 Q
S @GLOB@("EYET","TOTAL","CNT")=EYETOT
S @GLOB@("EYET","TOTAL","PERC")=EYETOT/PTOTAL*100
Q
DENTCALC ;EP - Dental exam calculation
N DENTTOT,PTOTAL
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S DENTTOT=$G(@GLOB@("HIVCHK","DENTPTCNT"))
; NOTE: Refusals were checked earlier and are included in DENTPTCNT.
I DENTTOT=0 Q
S @GLOB@("DENTT","TOTAL","CNT")=DENTTOT
S @GLOB@("DENTT","TOTAL","PERC")=DENTTOT/PTOTAL*100
Q
PAPCALC ; EP - Pap Smear Calculation
N PAPT,FTOTAL
S FTOTAL=$G(@GLOB@("FEMALE"))
I FTOTAL=0 Q
S PAPT=$G(@GLOB@("HIVCHK","PAPPTCNT"))
; NOTE: Refusals were checked earlier and are included in PAPPTCNT.
S @GLOB@("PAPT","TOTAL","CNT")=PAPT
S @GLOB@("PAPT","TOTAL","PERC")=PAPT/FTOTAL*100
Q
LIPCALC ; EP - Lipids Calculation
N CNT1,CNT2,LIPTOT,BKMDFN,PTOTAL
N DFNSTAT,REFVSTDT
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S LIPTOT=$G(@GLOB@("HIVCHK","LIPIDCNT")) I 'LIPTOT Q
S (BKMDFN,CNT1,CNT2)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"LIPID")),'$D(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF")) Q
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV")) S CNT1=CNT1+1
.I $D(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF")) S CNT2=CNT2+1
S @GLOB@("LIPT","TOTAL","PERC")=LIPTOT/PTOTAL*100
S @GLOB@("LIPT","TOTAL","CNT")=LIPTOT
S @GLOB@("LIPT","LIPIDARV","PERC")=CNT1/LIPTOT*100
S @GLOB@("LIPT","LIPIDARV","CNT")=CNT1
S @GLOB@("LIPT","LIPIDREF","PERC")=CNT2/LIPTOT*100
S @GLOB@("LIPT","LIPIDREF","CNT")=CNT2
Q
HEPCCALC ; EP - Hep C Calculation
N HEPCTOT,PTOTAL
N DFNSTAT,REFVSTDT
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S HEPCTOT=$G(@GLOB@("HIVCHK","HEPCCNT")) I 'HEPCTOT Q
S @GLOB@("HEPCT","TOTAL","PERC")=HEPCTOT/PTOTAL*100
S @GLOB@("HEPCT","TOTAL","CNT")=HEPCTOT
Q
CRCCALC ; EP - Colorectal Cancer Screen Calculation
N CNT1,CNT2,CRCTOT,BKMDFN,PTOTAL
N DFNSTAT,REFVSTDT
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S CRCTOT=$G(@GLOB@("HIVCHK","CRCCNT")) I 'CRCTOT Q
S (BKMDFN,CNT1,CNT2)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CRC")),'$D(@GLOB@("HIVCHK",BKMDFN,"CRCREF")) Q
.S CNT1=CNT1+1
.I $D(@GLOB@("HIVCHK",BKMDFN,"CRCREF")) S CNT2=CNT2+1
S @GLOB@("CRCT","TOTAL","PERC")=CRCTOT/PTOTAL*100
S @GLOB@("CRCT","TOTAL","CNT")=CRCTOT
S @GLOB@("CRCT","CRC","PERC")=CNT1/CRCTOT*100
S @GLOB@("CRCT","CRC","CNT")=CNT1
S @GLOB@("CRCT","CRCR","PERC")=CNT2/CRCTOT*100
S @GLOB@("CRCT","CRCR","CNT")=CNT2
Q
BKMQQCR8 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 28 Apr 2005 3:44 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Quality of Care Audit Report
+3 QUIT
PNEUMOC ; EP - Pneumo Calculation
+1 NEW PNTOT,BKMDFN,TOT5YR,TOTB5YR,VSTDT,HVSTDT,CNT,CNT1,CNT2,PTOTAL
+2 NEW REFVSTDT,PNDT5
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET PNTOT=$GET(@GLOB@("HIVCHK","PNEUMOCNT"))
+5 IF PNTOT<1
QUIT
+6 SET PNDT5=$$FMADD^XLFDT(EDATE,-1825)
+7 SET BKMDFN=0
SET (TOTB5YR,TOT5YR)=0
SET (CNT,CNT1,CNT2)=0
+8 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+9 SET VSTDT=0
SET TOT5YR=0
SET TOTB5YR=0
+10 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"PNEUMO",VSTDT))
IF VSTDT=""
QUIT
Begin DoDot:2
+11 IF VSTDT>PNDT5
SET TOT5YR=TOT5YR+1
+12 SET TOTB5YR=TOTB5YR+1
End DoDot:2
+13 ;We only want patients who have 1+ result in last 5 years, or 2+ results ever (including last 5 years)
+14 IF TOT5YR>0
SET CNT1=CNT1+1
SET CNT=CNT+1
QUIT
+15 IF TOTB5YR>1
SET CNT2=CNT2+1
SET CNT=CNT+1
QUIT
+16 ; Also include any refusals in the past year.
+17 SET REFVSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"PNEUMOREF",""),-1)
+18 IF REFVSTDT]""
IF $$FMDIFF^XLFDT(REFVSTDT,EDATE,1)'>365
SET CNT=CNT+1
End DoDot:1
+19 IF CNT=0
QUIT
+20 SET @GLOB@("PNEUMOT","TOTAL","CNT")=CNT
+21 SET @GLOB@("PNEUMOT","TOTAL","PERC")=CNT/PTOTAL*100
+22 SET @GLOB@("PNEUMOT","2B45YR","CNT")=CNT2
+23 SET @GLOB@("PNEUMOT","2B45YR","PERC")=CNT2/CNT*100
+24 SET @GLOB@("PNEUMOT","5YR","CNT")=CNT1
+25 SET @GLOB@("PNEUMOT","5YR","PERC")=CNT1/CNT*100
+26 QUIT
TETCALC ; EP - Tetanus Calculation
+1 NEW TETTOT,PTOTAL
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET TETTOT=$GET(@GLOB@("HIVCHK","TETPTCNT"))
+4 ; NOTE: Refusals were checked earlier and are included in TETPTCNT.
+5 IF TETTOT=0
QUIT
+6 SET @GLOB@("TETT","TOTAL","CNT")=TETTOT
+7 SET @GLOB@("TETT","TOTAL","PERC")=TETTOT/PTOTAL*100
+8 QUIT
EYECALC ; EP - Eye exam Calculation
+1 NEW EYETOT,PTOTAL
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET EYETOT=$GET(@GLOB@("HIVCHK","EYEPTCNT"))
+4 ; NOTE: Refusals were checked earlier and are included in EYEPTCNT.
+5 IF EYETOT=0
QUIT
+6 SET @GLOB@("EYET","TOTAL","CNT")=EYETOT
+7 SET @GLOB@("EYET","TOTAL","PERC")=EYETOT/PTOTAL*100
+8 QUIT
DENTCALC ;EP - Dental exam calculation
+1 NEW DENTTOT,PTOTAL
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET DENTTOT=$GET(@GLOB@("HIVCHK","DENTPTCNT"))
+4 ; NOTE: Refusals were checked earlier and are included in DENTPTCNT.
+5 IF DENTTOT=0
QUIT
+6 SET @GLOB@("DENTT","TOTAL","CNT")=DENTTOT
+7 SET @GLOB@("DENTT","TOTAL","PERC")=DENTTOT/PTOTAL*100
+8 QUIT
PAPCALC ; EP - Pap Smear Calculation
+1 NEW PAPT,FTOTAL
+2 SET FTOTAL=$GET(@GLOB@("FEMALE"))
+3 IF FTOTAL=0
QUIT
+4 SET PAPT=$GET(@GLOB@("HIVCHK","PAPPTCNT"))
+5 ; NOTE: Refusals were checked earlier and are included in PAPPTCNT.
+6 SET @GLOB@("PAPT","TOTAL","CNT")=PAPT
+7 SET @GLOB@("PAPT","TOTAL","PERC")=PAPT/FTOTAL*100
+8 QUIT
LIPCALC ; EP - Lipids Calculation
+1 NEW CNT1,CNT2,LIPTOT,BKMDFN,PTOTAL
+2 NEW DFNSTAT,REFVSTDT
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET LIPTOT=$GET(@GLOB@("HIVCHK","LIPIDCNT"))
IF 'LIPTOT
QUIT
+5 SET (BKMDFN,CNT1,CNT2)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"LIPID"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF"))
QUIT
+8 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDARV"))
SET CNT1=CNT1+1
+9 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"LIPIDREF"))
SET CNT2=CNT2+1
End DoDot:1
+10 SET @GLOB@("LIPT","TOTAL","PERC")=LIPTOT/PTOTAL*100
+11 SET @GLOB@("LIPT","TOTAL","CNT")=LIPTOT
+12 SET @GLOB@("LIPT","LIPIDARV","PERC")=CNT1/LIPTOT*100
+13 SET @GLOB@("LIPT","LIPIDARV","CNT")=CNT1
+14 SET @GLOB@("LIPT","LIPIDREF","PERC")=CNT2/LIPTOT*100
+15 SET @GLOB@("LIPT","LIPIDREF","CNT")=CNT2
+16 QUIT
HEPCCALC ; EP - Hep C Calculation
+1 NEW HEPCTOT,PTOTAL
+2 NEW DFNSTAT,REFVSTDT
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET HEPCTOT=$GET(@GLOB@("HIVCHK","HEPCCNT"))
IF 'HEPCTOT
QUIT
+5 SET @GLOB@("HEPCT","TOTAL","PERC")=HEPCTOT/PTOTAL*100
+6 SET @GLOB@("HEPCT","TOTAL","CNT")=HEPCTOT
+7 QUIT
CRCCALC ; EP - Colorectal Cancer Screen Calculation
+1 NEW CNT1,CNT2,CRCTOT,BKMDFN,PTOTAL
+2 NEW DFNSTAT,REFVSTDT
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET CRCTOT=$GET(@GLOB@("HIVCHK","CRCCNT"))
IF 'CRCTOT
QUIT
+5 SET (BKMDFN,CNT1,CNT2)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CRC"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CRCREF"))
QUIT
+8 SET CNT1=CNT1+1
+9 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"CRCREF"))
SET CNT2=CNT2+1
End DoDot:1
+10 SET @GLOB@("CRCT","TOTAL","PERC")=CRCTOT/PTOTAL*100
+11 SET @GLOB@("CRCT","TOTAL","CNT")=CRCTOT
+12 SET @GLOB@("CRCT","CRC","PERC")=CNT1/CRCTOT*100
+13 SET @GLOB@("CRCT","CRC","CNT")=CNT1
+14 SET @GLOB@("CRCT","CRCR","PERC")=CNT2/CRCTOT*100
+15 SET @GLOB@("CRCT","CRCR","CNT")=CNT2
+16 QUIT
