- 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
