BKMVQCR8.m

BKMVQCR8 ;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,DFN,TOT5YR,TOTB5YR,VSTDT,HVSTDT,CNT,CNT1,CNT2,PTOTAL

 N REFVSTDT,PNDT5

 S PTOTAL=$G(^TMP("BKMVQCR",$J,"HIVTOT1"))

 S PNTOT=$G(^TMP("BKMVQCR",$J,"HIVCHK","PNEUMOCNT"))

 I PNTOT<1 Q

 S PNDT5=$$FMADD^XLFDT(EDATE,-1825)

 S DFN=0,(TOTB5YR,TOT5YR)=0,(CNT,CNT1,CNT2)=0

 F  S DFN=$O(^TMP("BKMVQCR",$J,"HIVCHK",DFN)) Q:'DFN  D

 .S VSTDT=0,TOT5YR=0,TOTB5YR=0

 .F  S VSTDT=$O(^TMP("BKMVQCR",$J,"HIVCHK",DFN,"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(^TMP("BKMVQCR",$J,"HIVCHK",DFN,"PNEUMOREF",""),-1)

 .I REFVSTDT]"",$$FMDIFF^XLFDT(REFVSTDT,EDATE,1)'>365 S CNT=CNT+1

 I CNT=0 Q

 S ^TMP("BKMVQCR",$J,"PNEUMOT","TOTAL","CNT")=CNT

 S ^TMP("BKMVQCR",$J,"PNEUMOT","TOTAL","PERC")=CNT/PTOTAL*100

 S ^TMP("BKMVQCR",$J,"PNEUMOT","2B45YR","CNT")=CNT2

 S ^TMP("BKMVQCR",$J,"PNEUMOT","2B45YR","PERC")=CNT2/CNT*100

 S ^TMP("BKMVQCR",$J,"PNEUMOT","5YR","CNT")=CNT1

 S ^TMP("BKMVQCR",$J,"PNEUMOT","5YR","PERC")=CNT1/CNT*100

 Q

TETCALC ; EP - Tetanus Calculation

 N TETTOT,PTOTAL

 S PTOTAL=$G(^TMP("BKMVQCR",$J,"HIVTOT1"))

 S TETTOT=$G(^TMP("BKMVQCR",$J,"HIVCHK","TETPTCNT"))

 ; NOTE: Refusals were checked earlier and are included in TETPTCNT.

 I TETTOT=0 Q

 S ^TMP("BKMVQCR",$J,"TETT","TOTAL","CNT")=TETTOT

 S ^TMP("BKMVQCR",$J,"TETT","TOTAL","PERC")=TETTOT/PTOTAL*100

 Q

EYECALC ; EP - Eye exam Calculation

 N EYETOT,PTOTAL

 S PTOTAL=$G(^TMP("BKMVQCR",$J,"HIVTOT1"))

 S EYETOT=$G(^TMP("BKMVQCR",$J,"HIVCHK","EYEPTCNT"))

 ; NOTE: Refusals were checked earlier and are included in EYEPTCNT.

 I EYETOT=0 Q

 S ^TMP("BKMVQCR",$J,"EYET","TOTAL","CNT")=EYETOT

 S ^TMP("BKMVQCR",$J,"EYET","TOTAL","PERC")=EYETOT/PTOTAL*100

 Q

DENTCALC ;EP - Dental exam calculation

 N DENTTOT,PTOTAL

 S PTOTAL=$G(^TMP("BKMVQCR",$J,"HIVTOT1"))

 S DENTTOT=$G(^TMP("BKMVQCR",$J,"HIVCHK","DENTPTCNT"))

 ; NOTE: Refusals were checked earlier and are included in DENTPTCNT.

 I DENTTOT=0 Q

 S ^TMP("BKMVQCR",$J,"DENTT","TOTAL","CNT")=DENTTOT

 S ^TMP("BKMVQCR",$J,"DENTT","TOTAL","PERC")=DENTTOT/PTOTAL*100

 Q

PAPCALC ; EP - Pap Smear Calculation

 N PAPT,FTOTAL

 S FTOTAL=$G(^TMP("BKMVQCR",$J,"FEMALE"))

 I FTOTAL=0 Q

 S PAPT=$G(^TMP("BKMVQCR",$J,"HIVCHK","PAPPTCNT"))

 ; NOTE: Refusals were checked earlier and are included in PAPPTCNT.

 S ^TMP("BKMVQCR",$J,"PAPT","TOTAL","CNT")=PAPT

 S ^TMP("BKMVQCR",$J,"PAPT","TOTAL","PERC")=PAPT/FTOTAL*100

 Q

BKMVQCR8  ;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,DFN,TOT5YR,TOTB5YR,VSTDT,HVSTDT,CNT,CNT1,CNT2,PTOTAL

 +2        NEW REFVSTDT,PNDT5

 +3        SET PTOTAL=$GET(^TMP("BKMVQCR",$JOB,"HIVTOT1"))

 +4        SET PNTOT=$GET(^TMP("BKMVQCR",$JOB,"HIVCHK","PNEUMOCNT"))

 +5        IF PNTOT<1

               QUIT 

 +6        SET PNDT5=$$FMADD^XLFDT(EDATE,-1825)

 +7        SET DFN=0

           SET (TOTB5YR,TOT5YR)=0

           SET (CNT,CNT1,CNT2)=0

 +8        FOR 

               SET DFN=$ORDER(^TMP("BKMVQCR",$JOB,"HIVCHK",DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +9                SET VSTDT=0

                   SET TOT5YR=0

                   SET TOTB5YR=0

 +10               FOR 

                       SET VSTDT=$ORDER(^TMP("BKMVQCR",$JOB,"HIVCHK",DFN,"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(^TMP("BKMVQCR",$JOB,"HIVCHK",DFN,"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 ^TMP("BKMVQCR",$JOB,"PNEUMOT","TOTAL","CNT")=CNT

 +21       SET ^TMP("BKMVQCR",$JOB,"PNEUMOT","TOTAL","PERC")=CNT/PTOTAL*100

 +22       SET ^TMP("BKMVQCR",$JOB,"PNEUMOT","2B45YR","CNT")=CNT2

 +23       SET ^TMP("BKMVQCR",$JOB,"PNEUMOT","2B45YR","PERC")=CNT2/CNT*100

 +24       SET ^TMP("BKMVQCR",$JOB,"PNEUMOT","5YR","CNT")=CNT1

 +25       SET ^TMP("BKMVQCR",$JOB,"PNEUMOT","5YR","PERC")=CNT1/CNT*100

 +26       QUIT 

TETCALC   ; EP - Tetanus Calculation

 +1        NEW TETTOT,PTOTAL

 +2        SET PTOTAL=$GET(^TMP("BKMVQCR",$JOB,"HIVTOT1"))

 +3        SET TETTOT=$GET(^TMP("BKMVQCR",$JOB,"HIVCHK","TETPTCNT"))

 +4       ; NOTE: Refusals were checked earlier and are included in TETPTCNT.

 +5        IF TETTOT=0

               QUIT 

 +6        SET ^TMP("BKMVQCR",$JOB,"TETT","TOTAL","CNT")=TETTOT

 +7        SET ^TMP("BKMVQCR",$JOB,"TETT","TOTAL","PERC")=TETTOT/PTOTAL*100

 +8        QUIT 

EYECALC   ; EP - Eye exam Calculation

 +1        NEW EYETOT,PTOTAL

 +2        SET PTOTAL=$GET(^TMP("BKMVQCR",$JOB,"HIVTOT1"))

 +3        SET EYETOT=$GET(^TMP("BKMVQCR",$JOB,"HIVCHK","EYEPTCNT"))

 +4       ; NOTE: Refusals were checked earlier and are included in EYEPTCNT.

 +5        IF EYETOT=0

               QUIT 

 +6        SET ^TMP("BKMVQCR",$JOB,"EYET","TOTAL","CNT")=EYETOT

 +7        SET ^TMP("BKMVQCR",$JOB,"EYET","TOTAL","PERC")=EYETOT/PTOTAL*100

 +8        QUIT 

DENTCALC  ;EP - Dental exam calculation

 +1        NEW DENTTOT,PTOTAL

 +2        SET PTOTAL=$GET(^TMP("BKMVQCR",$JOB,"HIVTOT1"))

 +3        SET DENTTOT=$GET(^TMP("BKMVQCR",$JOB,"HIVCHK","DENTPTCNT"))

 +4       ; NOTE: Refusals were checked earlier and are included in DENTPTCNT.

 +5        IF DENTTOT=0

               QUIT 

 +6        SET ^TMP("BKMVQCR",$JOB,"DENTT","TOTAL","CNT")=DENTTOT

 +7        SET ^TMP("BKMVQCR",$JOB,"DENTT","TOTAL","PERC")=DENTTOT/PTOTAL*100

 +8        QUIT 

PAPCALC   ; EP - Pap Smear Calculation

 +1        NEW PAPT,FTOTAL

 +2        SET FTOTAL=$GET(^TMP("BKMVQCR",$JOB,"FEMALE"))

 +3        IF FTOTAL=0

               QUIT 

 +4        SET PAPT=$GET(^TMP("BKMVQCR",$JOB,"HIVCHK","PAPPTCNT"))

 +5       ; NOTE: Refusals were checked earlier and are included in PAPPTCNT.

 +6        SET ^TMP("BKMVQCR",$JOB,"PAPT","TOTAL","CNT")=PAPT

 +7        SET ^TMP("BKMVQCR",$JOB,"PAPT","TOTAL","PERC")=PAPT/FTOTAL*100

 +8        QUIT