BKMQQCR6 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Quality of Care Audit Report
Q
CD4CALC ; EP - CD4 calculation
N CD4TOT,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,FOUND,FOUND1,FOUND2,VSTDT,TEST,CD4CNT,PTOTAL
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S CD4TOT=$G(@GLOB@("HIVCHK","CD4PTCNT"))
I CD4TOT=""!(CD4TOT=0) Q
S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5,CNT6)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS")),'$D(@GLOB@("HIVCHK",BKMDFN,"CD4ALL")) Q
.S VSTDT="",(FOUND,FOUND1,FOUND2)=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT),-1) Q:VSTDT=""!(FOUND&FOUND1&FOUND2) D
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT,TEST),-1) Q:TEST=""!(FOUND&FOUND1&FOUND2) D
...S CD4CNT=$P($G(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT,TEST)),U)
...I CD4CNT'?1N.E Q
...;S FOUND=1
...I CD4CNT<50,'FOUND1 S:'FOUND CNT1=CNT1+1,FOUND=1 S FOUND1=1 Q
...I CD4CNT<200,'FOUND2 S:'FOUND CNT2=CNT2+1,FOUND=1 S FOUND2=1 Q
...S:'FOUND CNT3=CNT3+1
...S FOUND=1
.I 'FOUND S CNT4=CNT4+1 Q ; Includes patients with no ABS test but with an ALL test.
.;I FOUND1 S CNT5=CNT5+1
.;I FOUND2 S CNT6=CNT6+1
S BKMDFN=0,(CNT5,CNT6)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12")) Q
.S VSTDT="",(FOUND,FOUND1,FOUND2)=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT),-1) Q:VSTDT=""!(FOUND1&FOUND2) D
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST),-1) Q:TEST=""!(FOUND1&FOUND2) D
...S CD4CNT=$P($G(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)),U)
...I CD4CNT'?1N.E Q
...;S FOUND=1
...I CD4CNT<50,'FOUND1 S FOUND1=1 Q
...I CD4CNT<200,'FOUND2 S FOUND2=1 Q
.I FOUND1 S CNT5=CNT5+1
.I FOUND2 S CNT6=CNT6+1
S @GLOB@("CD4T","TOTAL","CNT")=CD4TOT
S @GLOB@("CD4T","TOTAL","PERC")=CD4TOT/PTOTAL*100
S @GLOB@("CD4T","LT50","PERC")=CNT1/CD4TOT*100
S @GLOB@("CD4T","LT50","CNT")=CNT1
S @GLOB@("CD4T","BET50/200","PERC")=CNT2/CD4TOT*100
S @GLOB@("CD4T","BET50/200","CNT")=CNT2
S @GLOB@("CD4T","GTE200","PERC")=CNT3/CD4TOT*100
S @GLOB@("CD4T","GTE200","CNT")=CNT3
S @GLOB@("CD4T","UND","PERC")=CNT4/CD4TOT*100
S @GLOB@("CD4T","UND","CNT")=CNT4
S @GLOB@("CD4T","LT50 ANY","CNT")=CNT5
;S @GLOB@("CD4T","BET50/200 ANY","CNT")=CNT6
S @GLOB@("CD4T","LT200 ANY","CNT")=CNT5+CNT6 ;***
Q
VRLLDC ; EP - Viral Load Calculation
N VRLTOT,BKMDFN,CNT1,CNT2,CNT3,VSTDT,TEST,VRLRES,FOUND,PTOTAL,RES,OPER
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S VRLTOT=$G(@GLOB@("HIVCHK","VRLPTCNT"))
I VRLTOT=""!(VRLTOT=0) Q
S BKMDFN=0,(CNT1,CNT2,CNT3)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"VRL")) Q
.S VSTDT="",FOUND=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT),-1) Q:VSTDT=""!FOUND D
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT,TEST),-1) Q:TEST=""!FOUND D
...S VRLRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT,TEST)),U)
...I VRLRES=""!(VRLRES?.A) Q
...;I VRLRES'?1N.E Q
...S FOUND=1
...S OPER=$S($E(VRLRES,1)="<":"<",$E(VRLRES,1)=">":">",1:"")
...S VRLRES=$S($E(VRLRES,1)?.P:$E(VRLRES,2,99),1:VRLRES)
...S RES=100000
...I OPER="" S OPER="<"
...I OPER="<",@(VRLRES_OPER_RES) S CNT1=CNT1+1 Q
...;I VRLRES<100000 S CNT1=CNT1+1 Q
...S CNT2=CNT2+1
.I 'FOUND S CNT3=CNT3+1
S @GLOB@("VRLT","TOTAL","CNT")=VRLTOT
S @GLOB@("VRLT","TOTAL","PERC")=VRLTOT/PTOTAL*100
S @GLOB@("VRLT","LT100K","CNT")=CNT1
S @GLOB@("VRLT","LT100K","PERC")=CNT1/VRLTOT*100
S @GLOB@("VRLT","GTE100K","CNT")=CNT2
S @GLOB@("VRLT","GTE100K","PERC")=CNT2/VRLTOT*100
S @GLOB@("VRLT","UND","CNT")=CNT3
S @GLOB@("VRLT","UND","PERC")=CNT3/VRLTOT*100
Q
RPRCALC ; EP - Rapid Plasma Reagin (and FTA-ABS) Calculation
N TOTALRPR,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,VSTDT,TEST,RPRRES,PTOTAL,REFVSTDT,DFNSTAT
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S TOTALRPR=$G(@GLOB@("HIVCHK","RPRPTCNT"))
I +TOTALRPR=0 Q
S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"RPRREF")),'$D(@GLOB@("HIVCHK",BKMDFN,"RPR")) Q
.S VSTDT="",FOUND=0,DFNSTAT=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT),-1) Q:VSTDT="" D Q:FOUND
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT,TEST),-1) Q:TEST="" D Q:FOUND
...S RPRRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT,TEST)),U)
...I $$POSITIVE^BKMVF32(RPRRES) S DFNSTAT=1,FOUND=1 Q
...I $$NEGATIVE^BKMVF32(RPRRES) S DFNSTAT=2,FOUND=1 Q
.S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"RPRREF",""),-1)
.D
..I REFVSTDT'="",REFVSTDT>VSTDT D Q
...S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"RPRREF",REFVSTDT,""),-1)
...S RPRRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"RPRREF",REFVSTDT,TEST)),U)
...I $P(RPRRES,"^")="NOT MEDICALLY INDICATED" S CNT5=CNT5+1 Q
...S CNT4=CNT4+1
..I DFNSTAT=1 S CNT1=CNT1+1 Q
..I DFNSTAT=2 S CNT2=CNT2+1 Q
..S CNT3=CNT3+1
S @GLOB@("RPRT","TOTAL","CNT")=TOTALRPR
S @GLOB@("RPRT","TOTAL","PERC")=TOTALRPR/PTOTAL*100
S @GLOB@("RPRT","REAC","CNT")=CNT1
S @GLOB@("RPRT","REAC","PERC")=CNT1/TOTALRPR*100
S @GLOB@("RPRT","NONREAC","CNT")=CNT2
S @GLOB@("RPRT","NONREAC","PERC")=CNT2/TOTALRPR*100
S @GLOB@("RPRT","UND","CNT")=CNT3
S @GLOB@("RPRT","UND","PERC")=CNT3/TOTALRPR*100
S @GLOB@("RPRT","REF","CNT")=CNT4
S @GLOB@("RPRT","REF","PERC")=CNT4/TOTALRPR*100
S @GLOB@("RPRT","REFNMI","CNT")=CNT5
S @GLOB@("RPRT","REFNMI","PERC")=CNT5/TOTALRPR*100
Q
BKMQQCR6 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ]
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Quality of Care Audit Report
+3 QUIT
CD4CALC ; EP - CD4 calculation
+1 NEW CD4TOT,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,FOUND,FOUND1,FOUND2,VSTDT,TEST,CD4CNT,PTOTAL
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET CD4TOT=$GET(@GLOB@("HIVCHK","CD4PTCNT"))
+4 IF CD4TOT=""!(CD4TOT=0)
QUIT
+5 SET BKMDFN=0
SET (CNT1,CNT2,CNT3,CNT4,CNT5,CNT6)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ABS"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ALL"))
QUIT
+8 SET VSTDT=""
SET (FOUND,FOUND1,FOUND2)=0
+9 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT),-1)
IF VSTDT=""!(FOUND&FOUND1&FOUND2)
QUIT
Begin DoDot:2
+10 SET TEST=""
+11 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT,TEST),-1)
IF TEST=""!(FOUND&FOUND1&FOUND2)
QUIT
Begin DoDot:3
+12 SET CD4CNT=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"CD4ABS",VSTDT,TEST)),U)
+13 IF CD4CNT'?1N.E
QUIT
+14 ;S FOUND=1
+15 IF CD4CNT<50
IF 'FOUND1
IF 'FOUND
SET CNT1=CNT1+1
SET FOUND=1
SET FOUND1=1
QUIT
+16 IF CD4CNT<200
IF 'FOUND2
IF 'FOUND
SET CNT2=CNT2+1
SET FOUND=1
SET FOUND2=1
QUIT
+17 IF 'FOUND
SET CNT3=CNT3+1
+18 SET FOUND=1
End DoDot:3
End DoDot:2
+19 ; Includes patients with no ABS test but with an ALL test.
IF 'FOUND
SET CNT4=CNT4+1
QUIT
+20 ;I FOUND1 S CNT5=CNT5+1
+21 ;I FOUND2 S CNT6=CNT6+1
End DoDot:1
+22 SET BKMDFN=0
SET (CNT5,CNT6)=0
+23 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+24 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12"))
QUIT
+25 SET VSTDT=""
SET (FOUND,FOUND1,FOUND2)=0
+26 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT),-1)
IF VSTDT=""!(FOUND1&FOUND2)
QUIT
Begin DoDot:2
+27 SET TEST=""
+28 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST),-1)
IF TEST=""!(FOUND1&FOUND2)
QUIT
Begin DoDot:3
+29 SET CD4CNT=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"CD4ABS12",VSTDT,TEST)),U)
+30 IF CD4CNT'?1N.E
QUIT
+31 ;S FOUND=1
+32 IF CD4CNT<50
IF 'FOUND1
SET FOUND1=1
QUIT
+33 IF CD4CNT<200
IF 'FOUND2
SET FOUND2=1
QUIT
End DoDot:3
End DoDot:2
+34 IF FOUND1
SET CNT5=CNT5+1
+35 IF FOUND2
SET CNT6=CNT6+1
End DoDot:1
+36 SET @GLOB@("CD4T","TOTAL","CNT")=CD4TOT
+37 SET @GLOB@("CD4T","TOTAL","PERC")=CD4TOT/PTOTAL*100
+38 SET @GLOB@("CD4T","LT50","PERC")=CNT1/CD4TOT*100
+39 SET @GLOB@("CD4T","LT50","CNT")=CNT1
+40 SET @GLOB@("CD4T","BET50/200","PERC")=CNT2/CD4TOT*100
+41 SET @GLOB@("CD4T","BET50/200","CNT")=CNT2
+42 SET @GLOB@("CD4T","GTE200","PERC")=CNT3/CD4TOT*100
+43 SET @GLOB@("CD4T","GTE200","CNT")=CNT3
+44 SET @GLOB@("CD4T","UND","PERC")=CNT4/CD4TOT*100
+45 SET @GLOB@("CD4T","UND","CNT")=CNT4
+46 SET @GLOB@("CD4T","LT50 ANY","CNT")=CNT5
+47 ;S @GLOB@("CD4T","BET50/200 ANY","CNT")=CNT6
+48 ;***
SET @GLOB@("CD4T","LT200 ANY","CNT")=CNT5+CNT6
+49 QUIT
VRLLDC ; EP - Viral Load Calculation
+1 NEW VRLTOT,BKMDFN,CNT1,CNT2,CNT3,VSTDT,TEST,VRLRES,FOUND,PTOTAL,RES,OPER
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET VRLTOT=$GET(@GLOB@("HIVCHK","VRLPTCNT"))
+4 IF VRLTOT=""!(VRLTOT=0)
QUIT
+5 SET BKMDFN=0
SET (CNT1,CNT2,CNT3)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"VRL"))
QUIT
+8 SET VSTDT=""
SET FOUND=0
+9 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT),-1)
IF VSTDT=""!FOUND
QUIT
Begin DoDot:2
+10 SET TEST=""
+11 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT,TEST),-1)
IF TEST=""!FOUND
QUIT
Begin DoDot:3
+12 SET VRLRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"VRL",VSTDT,TEST)),U)
+13 IF VRLRES=""!(VRLRES?.A)
QUIT
+14 ;I VRLRES'?1N.E Q
+15 SET FOUND=1
+16 SET OPER=$SELECT($EXTRACT(VRLRES,1)="<":"<",$EXTRACT(VRLRES,1)=">":">",1:"")
+17 SET VRLRES=$SELECT($EXTRACT(VRLRES,1)?.P:$EXTRACT(VRLRES,2,99),1:VRLRES)
+18 SET RES=100000
+19 IF OPER=""
SET OPER="<"
+20 IF OPER="<"
IF @(VRLRES_OPER_RES)
SET CNT1=CNT1+1
QUIT
+21 ;I VRLRES<100000 S CNT1=CNT1+1 Q
+22 SET CNT2=CNT2+1
End DoDot:3
End DoDot:2
+23 IF 'FOUND
SET CNT3=CNT3+1
End DoDot:1
+24 SET @GLOB@("VRLT","TOTAL","CNT")=VRLTOT
+25 SET @GLOB@("VRLT","TOTAL","PERC")=VRLTOT/PTOTAL*100
+26 SET @GLOB@("VRLT","LT100K","CNT")=CNT1
+27 SET @GLOB@("VRLT","LT100K","PERC")=CNT1/VRLTOT*100
+28 SET @GLOB@("VRLT","GTE100K","CNT")=CNT2
+29 SET @GLOB@("VRLT","GTE100K","PERC")=CNT2/VRLTOT*100
+30 SET @GLOB@("VRLT","UND","CNT")=CNT3
+31 SET @GLOB@("VRLT","UND","PERC")=CNT3/VRLTOT*100
+32 QUIT
RPRCALC ; EP - Rapid Plasma Reagin (and FTA-ABS) Calculation
+1 NEW TOTALRPR,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,VSTDT,TEST,RPRRES,PTOTAL,REFVSTDT,DFNSTAT
+2 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+3 SET TOTALRPR=$GET(@GLOB@("HIVCHK","RPRPTCNT"))
+4 IF +TOTALRPR=0
QUIT
+5 SET BKMDFN=0
SET (CNT1,CNT2,CNT3,CNT4,CNT5)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"RPRREF"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"RPR"))
QUIT
+8 SET VSTDT=""
SET FOUND=0
SET DFNSTAT=0
+9 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT),-1)
IF VSTDT=""
QUIT
Begin DoDot:2
+10 SET TEST=""
+11 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT,TEST),-1)
IF TEST=""
QUIT
Begin DoDot:3
+12 SET RPRRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"RPR",VSTDT,TEST)),U)
+13 IF $$POSITIVE^BKMVF32(RPRRES)
SET DFNSTAT=1
SET FOUND=1
QUIT
+14 IF $$NEGATIVE^BKMVF32(RPRRES)
SET DFNSTAT=2
SET FOUND=1
QUIT
End DoDot:3
IF FOUND
QUIT
End DoDot:2
IF FOUND
QUIT
+15 SET REFVSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"RPRREF",""),-1)
+16 Begin DoDot:2
+17 IF REFVSTDT'=""
IF REFVSTDT>VSTDT
Begin DoDot:3
+18 SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"RPRREF",REFVSTDT,""),-1)
+19 SET RPRRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"RPRREF",REFVSTDT,TEST)),U)
+20 IF $PIECE(RPRRES,"^")="NOT MEDICALLY INDICATED"
SET CNT5=CNT5+1
QUIT
+21 SET CNT4=CNT4+1
End DoDot:3
QUIT
+22 IF DFNSTAT=1
SET CNT1=CNT1+1
QUIT
+23 IF DFNSTAT=2
SET CNT2=CNT2+1
QUIT
+24 SET CNT3=CNT3+1
End DoDot:2
End DoDot:1
+25 SET @GLOB@("RPRT","TOTAL","CNT")=TOTALRPR
+26 SET @GLOB@("RPRT","TOTAL","PERC")=TOTALRPR/PTOTAL*100
+27 SET @GLOB@("RPRT","REAC","CNT")=CNT1
+28 SET @GLOB@("RPRT","REAC","PERC")=CNT1/TOTALRPR*100
+29 SET @GLOB@("RPRT","NONREAC","CNT")=CNT2
+30 SET @GLOB@("RPRT","NONREAC","PERC")=CNT2/TOTALRPR*100
+31 SET @GLOB@("RPRT","UND","CNT")=CNT3
+32 SET @GLOB@("RPRT","UND","PERC")=CNT3/TOTALRPR*100
+33 SET @GLOB@("RPRT","REF","CNT")=CNT4
+34 SET @GLOB@("RPRT","REF","PERC")=CNT4/TOTALRPR*100
+35 SET @GLOB@("RPRT","REFNMI","CNT")=CNT5
+36 SET @GLOB@("RPRT","REFNMI","PERC")=CNT5/TOTALRPR*100
+37 QUIT
