BKMQQCR8.m

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