BKMQQCR9.m

BKMQQCR9 ;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

ARVCALC ; EP - ARV (HAART) Calculation

 N ARVTOT,BKMDFN,PTOTAL,CNT1,CNT2,CNT3,VSTDT,TEST

 N CNTM02,CNTM03,CNTM05,CNTM09,CNTM10,CNTM11,CNTM12,CNTM13

 NEW TYPE

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 S ARVTOT=0,BKMDFN=0,(CNT1,CNT2,CNT3)=0

 F TYPE="HCD4RES1","HCD4RES2","HCD4RES3","HCD4RES4" S @GLOB@(TYPE,"TOTAL","CNT")=0

 S @GLOB@("NOHAART","TOTAL","CNT")=0

 F TYPE="NHCD4RES1","NHCD4RES2","NHCD4RES3","NHCD4RES4" S @GLOB@(TYPE,"TOTAL","CNT")=0

 S @GLOB@("HVIRAL","TOTAL","CNT")=0,@GLOB@("HCDVRL","TOTAL","CNT")=0

 S @GLOB@("HAART","TOTAL","CNT")=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 .S VSTDT="",CNTM02=0,CNTM03=0,CNTM05=0,CNTM09=0,CNTM10=0,CNTM11=0,CNTM12=0,CNTM13=0

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM02",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM02",VSTDT,TEST)) Q:TEST=""  S CNTM02=CNTM02+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM03",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM03",VSTDT,TEST)) Q:TEST=""  S CNTM03=CNTM03+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM05",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM05",VSTDT,TEST)) Q:TEST=""  S CNTM05=CNTM05+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM09",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM09",VSTDT,TEST)) Q:TEST=""  S CNTM09=CNTM09+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM10",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM10",VSTDT,TEST)) Q:TEST=""  S CNTM10=CNTM10+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM11",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM11",VSTDT,TEST)) Q:TEST=""  S CNTM11=CNTM11+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM12",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM12",VSTDT,TEST)) Q:TEST=""  S CNTM12=CNTM12+1

 .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM13",VSTDT)) Q:VSTDT=""  D

 ..S TEST=""

 ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"ARVM13",VSTDT,TEST)) Q:TEST=""  S CNTM13=CNTM13+1

 .I CNTM02+CNTM03+CNTM05+CNTM09+CNTM10+CNTM11+CNTM12+CNTM13=0 D NOHRT(BKMDFN) Q

 .S ARVTOT=ARVTOT+1

 .I CNTM11>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM02+CNTM03+CNTM05+CNTM09+CNTM10+CNTM11+CNTM12+CNTM13=1 S CNT2=CNT2+1 Q

 .; 9 different criteria will classify medications as HAART

 .I CNTM05>0,CNTM03>1 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM05>0,CNTM12>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM03>1,CNTM02>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM12>0,CNTM02>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM09>0,CNTM02+CNTM03+CNTM05>1 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM09>0,CNTM12>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM10>0,CNTM02+CNTM03+CNTM05>1 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .I CNTM10>0,CNTM12>0 S CNT1=CNT1+1 D HRT(BKMDFN) Q

 .S CNT3=CNT3+1

 .D NOHRT(BKMDFN)

 ;

 NEW HRTTOT,NUM

 S HRTTOT=$G(@GLOB@("NOHAART","TOTAL","CNT")) D

 . I +HRTTOT=0 Q

 . S @GLOB@("NOHAART","TOTAL","PERC")=HRTTOT/PTOTAL*100

 . F TYPE="NHCD4RES1","NHCD4RES2","NHCD4RES3","NHCD4RES4" D

 .. S NUMB=$G(@GLOB@(TYPE,"TOTAL","CNT"))

 .. I +NUMB=0 Q

 .. S @GLOB@(TYPE,"TOTAL","PERC")=NUMB/HRTTOT*100

 ;

 S HRTTOT=$G(@GLOB@("HAART","TOTAL","CNT")) D

 . I +HRTTOT=0 Q

 . S @GLOB@("HAART","TOTAL","PERC")=HRTTOT/PTOTAL*100

 . F TYPE="HCD4RES1","HCD4RES2","HCD4RES3","HCD4RES4" D

 .. NEW NUMB

 .. S NUMB=$G(@GLOB@(TYPE,"TOTAL","CNT"))

 .. I +NUMB=0 Q

 .. S @GLOB@(TYPE,"TOTAL","PERC")=NUMB/HRTTOT*100

 . F TYPE="HVIRSUP","HVIRNOT","HVIR6M" D

 .. NEW NUMB

 .. S NUMB=$G(@GLOB@(TYPE,"TOTAL","CNT"))

 .. I +NUMB=0 Q

 .. S @GLOB@(TYPE,"TOTAL","PERC")=NUMB/HRTTOT*100

 ;

 I ARVTOT=0 Q

 S @GLOB@("ARVT","TOTAL","CNT")=ARVTOT

 S @GLOB@("ARVT","TOTAL","PERC")=ARVTOT/PTOTAL*100

 ;S @GLOB@("ARVT","HAART","CNT")=CNT1

 ;S @GLOB@("ARVT","HAART","PERC")=CNT1/ARVTOT*100

 S @GLOB@("ARVT","MONO","CNT")=CNT2

 S @GLOB@("ARVT","MONO","PERC")=CNT2/ARVTOT*100

 S @GLOB@("ARVT","OTHER","CNT")=CNT3

 S @GLOB@("ARVT","OTHER","PERC")=CNT3/ARVTOT*100

 Q

PCP ; EP - PCP Calculation

 N PCPTOT,CD4TOT

 S CD4TOT=$G(@GLOB@("CD4T","LT200 ANY","CNT"))

 I CD4TOT<1 Q

 S PCPTOT=$G(@GLOB@("HIVCHK","PCPPTCNT"))

 S @GLOB@("PCPT","TOTAL","CNT")=PCPTOT

 S @GLOB@("PCPT","TOTAL","PERC")=PCPTOT/CD4TOT*100

 Q

MAC ; EP - MAC Calculation

 N MACTOT,CD4TOT

 S CD4TOT=$G(@GLOB@("CD4T","LT50 ANY","CNT"))

 I CD4TOT<1 Q

 S MACTOT=$G(@GLOB@("HIVCHK","MACPTCNT"))

 S @GLOB@("MACT","TOTAL","CNT")=MACTOT

 S @GLOB@("MACT","TOTAL","PERC")=MACTOT/CD4TOT*100

 Q

TOBCALC ; EP - Tobacco use Calculation

 N BKMDFN,CNT1,CNT2,CNT3,CNT4,PTOTAL,TOBTOT

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 I PTOTAL=0 Q

 S TOBTOT=$G(@GLOB@("HIVCHK","TOBTOT"))

 I TOBTOT<1 Q

 S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4)=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 .I $D(@GLOB@("HIVCHK",BKMDFN,"TOBNONUSER")) S CNT3=CNT3+1 Q  ; Non-Current Tobacco User

 .I '$D(@GLOB@("HIVCHK",BKMDFN,"TOB")) Q  ; Only sub-total those who have been screened

 .I $D(@GLOB@("HIVCHK",BKMDFN,"TOBUSER")) S CNT1=CNT1+1 D  Q  ; Current Tobacco User

 ..;Only count tobacco counseling on current tobacco users

 ..I $D(@GLOB@("HIVCHK",BKMDFN,"TOBED")) S CNT2=CNT2+1

 ..Q

 .S CNT4=CNT4+1 ; Screened, but not documented as to Current or Non-Current Tobacco User

 S @GLOB@("TOBT","SCREEN","CNT")=TOBTOT

 S @GLOB@("TOBT","SCREEN","PERC")=TOBTOT/PTOTAL*100

 S @GLOB@("TOBT","USER","CNT")=CNT1

 S @GLOB@("TOBT","USER","PERC")=CNT1/TOBTOT*100

 S @GLOB@("TOBT","ED","CNT")=CNT2

 S @GLOB@("TOBT","ED","PERC")=CNT2/TOBTOT*100

 S @GLOB@("TOBT","NON","CNT")=CNT3

 S @GLOB@("TOBT","NON","PERC")=CNT3/TOBTOT*100

 S @GLOB@("TOBT","UNK","CNT")=CNT4

 S @GLOB@("TOBT","UNK","PERC")=CNT4/TOBTOT*100

 Q

 ;

APHCALC ; EP - Appropriate/Adherence calculations

 N VISTOT,PTOTAL

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVPCNT","P1"))

 . I VISTOT'=0 D

 .. S @GLOB@("AHCP1","TOTAL","CNT")=VISTOT

 .. S @GLOB@("AHCP1","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVPCNT","P2"))

 . I VISTOT'=0 D

 .. S @GLOB@("AHCP2","TOTAL","CNT")=VISTOT

 .. S @GLOB@("AHCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVPCNT","P3"))

 . I VISTOT'=0 D

 .. S @GLOB@("AHCP3","TOTAL","CNT")=VISTOT

 .. S @GLOB@("AHCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVAPPCNT")) I VISTOT=0 Q

 . S @GLOB@("APPMGT","TOTAL","CNT")=VISTOT

 . S @GLOB@("APPMGT","TOTAL","PERC")=VISTOT/PTOTAL*100

 . ;S VISTOT=$G(@GLOB@("HIVCHK","ARVAPPCNT","P2")) I VISTOT=0 Q

 . ;S @GLOB@("APCP2","TOTAL","CNT")=VISTOT

 . ;S @GLOB@("APCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . ;S VISTOT=$G(@GLOB@("HIVCHK","ARVAPPCNT","P3")) I VISTOT=0 Q

 . ;S @GLOB@("APCP3","TOTAL","CNT")=VISTOT

 . ;S @GLOB@("APCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVUNPCNT","P1"))

 . I VISTOT'=0 D

 .. S @GLOB@("UNCP1","TOTAL","CNT")=VISTOT

 .. S @GLOB@("UNCP1","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVUNPCNT","P2"))

 . I VISTOT'=0 D

 .. S @GLOB@("UNCP2","TOTAL","CNT")=VISTOT

 .. S @GLOB@("UNCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVUNPCNT","P3"))

 . I VISTOT'=0 D

 .. S @GLOB@("UNCP3","TOTAL","CNT")=VISTOT

 .. S @GLOB@("UNCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVSTPCNT","P1"))

 . I VISTOT'=0 D

 .. S @GLOB@("STCP1","TOTAL","CNT")=VISTOT

 .. S @GLOB@("STCP1","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVSTPCNT","P2"))

 . I VISTOT'=0 D

 .. S @GLOB@("STCP2","TOTAL","CNT")=VISTOT

 .. S @GLOB@("STCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVSTPCNT","P3"))

 . I VISTOT'=0 D

 .. S @GLOB@("STCP3","TOTAL","CNT")=VISTOT

 .. S @GLOB@("STCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVESPCNT","P1"))

 . I VISTOT'=0 D

 .. S @GLOB@("ENCP1","TOTAL","CNT")=VISTOT

 .. S @GLOB@("ENCP1","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVESPCNT","P2"))

 . I VISTOT'=0 D

 .. S @GLOB@("ENCP2","TOTAL","CNT")=VISTOT

 .. S @GLOB@("ENCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVESPCNT","P3"))

 . I VISTOT'=0 D

 .. S @GLOB@("ENCP3","TOTAL","CNT")=VISTOT

 .. S @GLOB@("ENCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVTOPCNT","P1"))

 . I VISTOT'=0 D

 .. S @GLOB@("NNCP1","TOTAL","CNT")=VISTOT

 .. S @GLOB@("NNCP1","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVTOPCNT","P2"))

 . I VISTOT'=0 D

 .. S @GLOB@("NNCP2","TOTAL","CNT")=VISTOT

 .. S @GLOB@("NNCP2","TOTAL","PERC")=VISTOT/PTOTAL*100

 . S VISTOT=$G(@GLOB@("HIVCHK","ARVTOPCNT","P3"))

 . I VISTOT'=0 D

 .. S @GLOB@("NNCP3","TOTAL","CNT")=VISTOT

 .. S @GLOB@("NNCP3","TOTAL","PERC")=VISTOT/PTOTAL*100

 Q

 ;

SUBCALC ; EP - Substance abuse Calculation

 N BKMDFN,PTOTAL,CNT1,CNT2,CNT3,CNT4

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 I PTOTAL=0 Q

 S BKMDFN=0,CNT1=0,CNT2=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . I $D(@GLOB@("HIVCHK",BKMDFN,"SUBS01")) S CNT1=CNT1+1

 I CNT1<1 Q

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D

 . I $D(@GLOB@("HIVCHK",BKMDFN,"SUBS01CURR")) S CNT2=CNT2+1

 ; No info on how to calculate 'Not Current', or 'IV'. Assume 0 for now.

 S CNT3=0,CNT4=0

 S @GLOB@("SUBST","TOTAL","CNT")=CNT1

 S @GLOB@("SUBST","TOTAL","PERC")=CNT1/PTOTAL*100

 S @GLOB@("SUBST","CURRENT","CNT")=CNT2

 S @GLOB@("SUBST","CURRENT","PERC")=CNT2/CNT1*100

 ; Can't calculate yet.

 ;S @GLOB@("SUBST","IV","CNT")=CNT3

 ;S @GLOB@("SUBST","IV","PERC")=CNT3/CNT2*100

 ;S @GLOB@("SUBST","NOT","CNT")=CNT4

 ;S @GLOB@("SUBST","NOT","PERC")=CNT4/CNT1*100

 S @GLOB@("SUBST","UNK","CNT")=CNT1-(CNT2+CNT4)

 S @GLOB@("SUBST","UNK","PERC")=CNT1-(CNT2+CNT4)/CNT1*100

 Q

 ;

VISCALC ; EP - Visits Calculation

 N VISTOT,PTOTAL

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","V4MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("V4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("V4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","V6MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("V6M","TOTAL","CNT")=VISTOT

 . S @GLOB@("V6M","TOTAL","PERC")=VISTOT/PTOTAL*100

 ;

 S PTOTAL=$G(@GLOB@("HIVCHK","V4MPTCNT"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","CD4MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("CD4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("CD4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","VR4MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("VR4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("VR4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","BTH4MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("BT4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("BT4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 ;

 S PTOTAL=$G(@GLOB@("HIVCHK","V6MPTCNT"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","CD6MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("CD6M","TOTAL","CNT")=VISTOT

 . S @GLOB@("CD6M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","VR6MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("VR6M","TOTAL","CNT")=VISTOT

 . S @GLOB@("VR6M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","BTH6MPTCNT")) I VISTOT=0 Q

 . S @GLOB@("BT6M","TOTAL","CNT")=VISTOT

 . S @GLOB@("BT6M","TOTAL","PERC")=VISTOT/PTOTAL*100

 Q

 ;

LABCALC ; EP - Labs Calculation

 NEW VISTOT,PTOTAL

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","LCD4MPTCNT")) I VISTOT=0 Q

 . ;S @GLOB@("LCD4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("LCD4M")=VISTOT

 . ;S @GLOB@("LCD4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","LVR4MPTCNT")) I VISTOT=0 Q

 . ;S @GLOB@("LVR4M","TOTAL","CNT")=VISTOT

 . S @GLOB@("LVR4M")=VISTOT

 . ;S @GLOB@("LVR4M","TOTAL","PERC")=VISTOT/PTOTAL*100

 Q

 ;

HRT(BKVAL) ;

 S @GLOB@("HAART","TOTAL","CNT")=$G(@GLOB@("HAART","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES1"))'=0 S @GLOB@("HCD4RES1","TOTAL","CNT")=$G(@GLOB@("HCD4RES1","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES2"))'=0 S @GLOB@("HCD4RES2","TOTAL","CNT")=$G(@GLOB@("HCD4RES2","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES3"))'=0 S @GLOB@("HCD4RES3","TOTAL","CNT")=$G(@GLOB@("HCD4RES3","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES4"))'=0 S @GLOB@("HCD4RES4","TOTAL","CNT")=$G(@GLOB@("HCD4RES4","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"VIRALSUP"))'=0 S @GLOB@("HVIRSUP","TOTAL","CNT")=$G(@GLOB@("HVIRSUP","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"VIRALNSU"))'=0 S @GLOB@("HVIRNOT","TOTAL","CNT")=$G(@GLOB@("HVIRNOT","TOTAL","CNT"))+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"NOVIRAL"))=0 S @GLOB@("HVIR6M","TOTAL","CNT")=$G(@GLOB@("HVIR6M","TOTAL","CNT"))+1

 Q

 ;

NOHRT(BKVAL) ; No HAART

 S @GLOB@("NOHAART","TOTAL","CNT")=@GLOB@("NOHAART","TOTAL","CNT")+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES1"))'=0 S @GLOB@("NHCD4RES1","TOTAL","CNT")=@GLOB@("NHCD4RES1","TOTAL","CNT")+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES2"))'=0 S @GLOB@("NHCD4RES2","TOTAL","CNT")=@GLOB@("NHCD4RES2","TOTAL","CNT")+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES3"))'=0 S @GLOB@("NHCD4RES3","TOTAL","CNT")=@GLOB@("NHCD4RES3","TOTAL","CNT")+1

 I +$G(@GLOB@("HIVCHK",BKVAL,"CD4RES4"))'=0 S @GLOB@("NHCD4RES4","TOTAL","CNT")=@GLOB@("NHCD4RES4","TOTAL","CNT")+1

 Q

 ;

MHCHK ;

 NEW MTOT

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK","MH",BKMDFN)) Q:'BKMDFN  D

 . S MTOT=0

 . F TYP="MHDV","MHDEP","MHANX","MHCOG","MHSLEEP","MHAPP","MHPTSD","MHPSYC" D

 .. I $G(@GLOB@("HIVCHK","MH",BKMDFN,TYP))'="" S MTOT=MTOT+1,@GLOB@(TYP,"TOTAL","CNT")=$G(@GLOB@(TYP,"TOTAL","CNT"))+1

 . I MTOT=8 S @GLOB@("HIVCHK","MHASM","TOTAL","CNT")=$G(@GLOB@("HIVCHK","MHASM","TOTAL","CNT"))+1

 Q

 ;

EDCHK ;

 S BKMDFN=0

 F  S BKMDFN=$O(@GLOB@("HIVCHK","MH",BKMDFN)) Q:'BKMDFN  D

 . F TYP="SSEX","FPLN","HIVED" I $G(@GLOB@("HIVCHK","MH",BKMDFN,TYP))'="" S @GLOB@(TYP,"TOTAL","CNT")=$G(@GLOB@(TYP,"TOTAL","CNT"))+1

 ;

 S PTOTAL=$G(@GLOB@("HIVTOT1"))

 D

 . S VISTOT=$G(@GLOB@("HIVCHK","MHASM","TOTAL","CNT"))

 . I VISTOT="" S @GLOB@("MHSCRN","TOTAL","CNT")=0,@GLOB@("MHSCRN","TOTAL","PERC")=0 Q

 . S @GLOB@("MHSCRN","TOTAL","CNT")=VISTOT

 . S @GLOB@("MHSCRN","TOTAL","PERC")=VISTOT/PTOTAL*100

 F TYP="MHDV","MHDEP","MHANX","MHCOG","MHSLEEP","MHAPP","MHPTSD","MHPSYC" D

 . S VISTOT=$G(@GLOB@(TYP,"TOTAL","CNT"))

 . I VISTOT="" S @GLOB@(TYP,"TOTAL","CNT")=0,@GLOB@(TYP,"TOTAL","PERC")=0 Q

 . S @GLOB@(TYP,"TOTAL","PERC")=VISTOT/PTOTAL*100

 F TYP="SSEX","FPLN","HIVED" D

 . S VISTOT=$G(@GLOB@(TYP,"TOTAL","CNT"))

 . I VISTOT="" S @GLOB@(TYP,"TOTAL","CNT")=0,@GLOB@(TYP,"TOTAL","PERC")=0 Q

 . S @GLOB@(TYP,"TOTAL","PERC")=VISTOT/PTOTAL*100

 Q

BKMQQCR9  ;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 

ARVCALC   ; EP - ARV (HAART) Calculation

 +1        NEW ARVTOT,BKMDFN,PTOTAL,CNT1,CNT2,CNT3,VSTDT,TEST

 +2        NEW CNTM02,CNTM03,CNTM05,CNTM09,CNTM10,CNTM11,CNTM12,CNTM13

 +3        NEW TYPE

 +4        SET PTOTAL=$GET(@GLOB@("HIVTOT1"))

 +5        SET ARVTOT=0

           SET BKMDFN=0

           SET (CNT1,CNT2,CNT3)=0

 +6        FOR TYPE="HCD4RES1","HCD4RES2","HCD4RES3","HCD4RES4"

               SET @GLOB@(TYPE,"TOTAL","CNT")=0

 +7        SET @GLOB@("NOHAART","TOTAL","CNT")=0

 +8        FOR TYPE="NHCD4RES1","NHCD4RES2","NHCD4RES3","NHCD4RES4"

               SET @GLOB@(TYPE,"TOTAL","CNT")=0

 +9        SET @GLOB@("HVIRAL","TOTAL","CNT")=0

           SET @GLOB@("HCDVRL","TOTAL","CNT")=0

 +10       SET @GLOB@("HAART","TOTAL","CNT")=0

 +11       FOR 

               SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))

               IF 'BKMDFN

                   QUIT 

               Begin DoDot:1

 +12               SET VSTDT=""

                   SET CNTM02=0

                   SET CNTM03=0

                   SET CNTM05=0

                   SET CNTM09=0

                   SET CNTM10=0

                   SET CNTM11=0

                   SET CNTM12=0

                   SET CNTM13=0

 +13               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM02",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +14                       SET TEST=""

 +15                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM02",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM02=CNTM02+1

                       End DoDot:2

 +16               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM03",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +17                       SET TEST=""

 +18                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM03",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM03=CNTM03+1

                       End DoDot:2

 +19               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM05",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +20                       SET TEST=""

 +21                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM05",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM05=CNTM05+1

                       End DoDot:2

 +22               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM09",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +23                       SET TEST=""

 +24                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM09",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM09=CNTM09+1

                       End DoDot:2

 +25               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM10",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +26                       SET TEST=""

 +27                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM10",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM10=CNTM10+1

                       End DoDot:2

 +28               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM11",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +29                       SET TEST=""

 +30                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM11",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM11=CNTM11+1

                       End DoDot:2

 +31               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM12",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +32                       SET TEST=""

 +33                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM12",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM12=CNTM12+1

                       End DoDot:2

 +34               FOR 

                       SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM13",VSTDT))

                       IF VSTDT=""

                           QUIT 

                       Begin DoDot:2

 +35                       SET TEST=""

 +36                       FOR 

                               SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"ARVM13",VSTDT,TEST))

                               IF TEST=""

                                   QUIT 

                               SET CNTM13=CNTM13+1

                       End DoDot:2

 +37               IF CNTM02+CNTM03+CNTM05+CNTM09+CNTM10+CNTM11+CNTM12+CNTM13=0

                       DO NOHRT(BKMDFN)

                       QUIT 

 +38               SET ARVTOT=ARVTOT+1

 +39               IF CNTM11>0

                       SET CNT1=CNT1+1

                       DO HRT(BKMDFN)

                       QUIT 

 +40               IF CNTM02+CNTM03+CNTM05+CNTM09+CNTM10+CNTM11+CNTM12+CNTM13=1

                       SET CNT2=CNT2+1

                       QUIT 

 +41      ; 9 different criteria will classify medications as HAART

 +42               IF CNTM05>0

                       IF CNTM03>1

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +43               IF CNTM05>0

                       IF CNTM12>0

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +44               IF CNTM03>1

                       IF CNTM02>0

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +45               IF CNTM12>0

                       IF CNTM02>0

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +46               IF CNTM09>0

                       IF CNTM02+CNTM03+CNTM05>1

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +47               IF CNTM09>0

                       IF CNTM12>0

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +48               IF CNTM10>0

                       IF CNTM02+CNTM03+CNTM05>1

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +49               IF CNTM10>0

                       IF CNTM12>0

                           SET CNT1=CNT1+1

                           DO HRT(BKMDFN)

                           QUIT 

 +50               SET CNT3=CNT3+1

 +51               DO NOHRT(BKMDFN)

               End DoDot:1

 +52      ;

 +53       NEW HRTTOT,NUM

 +54       SET HRTTOT=$GET(@GLOB@("NOHAART","TOTAL","CNT"))

           Begin DoDot:1

 +55           IF +HRTTOT=0

                   QUIT 

 +56           SET @GLOB@("NOHAART","TOTAL","PERC")=HRTTOT/PTOTAL*100

 +57           FOR TYPE="NHCD4RES1","NHCD4RES2","NHCD4RES3","NHCD4RES4"

                   Begin DoDot:2

 +58                   SET NUMB=$GET(@GLOB@(TYPE,"TOTAL","CNT"))

 +59                   IF +NUMB=0

                           QUIT 

 +60                   SET @GLOB@(TYPE,"TOTAL","PERC")=NUMB/HRTTOT*100

                   End DoDot:2

           End DoDot:1

 +61      ;

 +62       SET HRTTOT=$GET(@GLOB@("HAART","TOTAL","CNT"))

           Begin DoDot:1

 +63           IF +HRTTOT=0

                   QUIT 

 +64           SET @GLOB@("HAART","TOTAL","PERC")=HRTTOT/PTOTAL*100

 +65           FOR TYPE="HCD4RES1","HCD4RES2","HCD4RES3","HCD4RES4"

                   Begin DoDot:2

 +66                   NEW NUMB

 +67                   SET NUMB=$GET(@GLOB@(TYPE,"TOTAL","CNT"))

 +68                   IF +NUMB=0

                           QUIT 

 +69                   SET @GLOB@(TYPE,"TOTAL","PERC")=NUMB/HRTTOT*100