BKMQQCR7 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 10 May 2005 4:12 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
; Quality of Care Audit Report
Q
CHLAMC ; EP - Chlamydia Calculation
N CNT1,CNT2,CNT3,CNT4,CNT5,CHLTOT,BKMDFN,VSTDT,TEST,CHLRES,FMDT,ITEM,FOUND,PTOTAL
N DFNSTAT,REFVSTDT,SEX
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S CHLTOT=$G(@GLOB@("HIVCHK","CHLAMPTCNT"))
I CHLTOT=0!(CHLTOT="") Q
S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5)=0,SEX("M")="",SEX("F")=""
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"CHLAM")),'$D(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF")) Q
.S SEX=$$SEX(BKMDFN) I SEX'="" S SEX(SEX)=SEX(SEX)+1
.S VSTDT="",FOUND=0,DFNSTAT=0
.S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",""),-1)
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT),-1) Q:VSTDT="" D Q:FOUND
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST),-1) Q:TEST="" D Q:FOUND
...S CHLRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST)),U)
...I $$POSITIVE^BKMVF32(CHLRES) S DFNSTAT=1,FOUND=1 Q
...I $$NEGATIVE^BKMVF32(CHLRES) S DFNSTAT=2,FOUND=1 Q
.D
..I REFVSTDT'="",REFVSTDT>VSTDT D Q
...S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,""),-1)
...S CHLRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,TEST)),U)
...I $P(CHLRES,"^")="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@("CHLAMT","TOTAL","PERC")=CHLTOT/PTOTAL*100
S @GLOB@("CHLAMT","TOTAL","CNT")=CHLTOT
S @GLOB@("CHLAMT","MALE","PERC")=SEX("M")/CHLTOT*100
S @GLOB@("CHLAMT","MALE","CNT")=SEX("M")
S @GLOB@("CHLAMT","FEMALE","PERC")=SEX("F")/CHLTOT*100
S @GLOB@("CHLAMT","FEMALE","CNT")=SEX("F")
S @GLOB@("CHLAMT","POS","PERC")=CNT1/CHLTOT*100
S @GLOB@("CHLAMT","POS","CNT")=CNT1
S @GLOB@("CHLAMT","NEG","PERC")=CNT2/CHLTOT*100
S @GLOB@("CHLAMT","NEG","CNT")=CNT2
S @GLOB@("CHLAMT","UND","PERC")=CNT3/CHLTOT*100
S @GLOB@("CHLAMT","UND","CNT")=CNT3
S @GLOB@("CHLAMT","REF","PERC")=CNT4/CHLTOT*100
S @GLOB@("CHLAMT","REF","CNT")=CNT4
S @GLOB@("CHLAMT","REFNMI","PERC")=CNT5/CHLTOT*100
S @GLOB@("CHLAMT","REFNMI","CNT")=CNT5
Q
GONCALC ; EP - Gonorrhea Calculation
N CNT1,CNT2,CNT3,CNT4,CNT5,GONTOT,BKMDFN,VSTDT,TEST,GONRES,FMDT,ITEM,FOUND,PTOTAL
N DFNSTAT,REFVSTDT
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S GONTOT=$G(@GLOB@("HIVCHK","GONPTCNT"))
I GONTOT=0!(GONTOT="") Q
S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5)=0,SEX("M")="",SEX("F")=""
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I '$D(@GLOB@("HIVCHK",BKMDFN,"GON")),'$D(@GLOB@("HIVCHK",BKMDFN,"GONREF")) Q
.S SEX=$$SEX(BKMDFN) I SEX'="" S SEX(SEX)=SEX(SEX)+1
.S VSTDT="",FOUND=0,DFNSTAT=0
.F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT),-1) Q:VSTDT="" D Q:FOUND
..S TEST=""
..F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST),-1) Q:TEST="" D Q:FOUND
...S GONRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST)),U)
...I $$POSITIVE^BKMVF32(GONRES) S DFNSTAT=1,FOUND=1 Q
...I $$NEGATIVE^BKMVF32(GONRES) S DFNSTAT=2,FOUND=1 Q
.S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"GONREF",""),-1)
.D
..I REFVSTDT'="",REFVSTDT>VSTDT D Q
...S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,""),-1)
...S GONRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,TEST)),U)
...I $P(GONRES,"^")="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@("GONT","TOTAL","PERC")=GONTOT/PTOTAL*100
S @GLOB@("GONT","TOTAL","CNT")=GONTOT
S @GLOB@("GONT","MALE","PERC")=SEX("M")/GONTOT*100
S @GLOB@("GONT","MALE","CNT")=SEX("M")
S @GLOB@("GONT","FEMALE","PERC")=SEX("F")/GONTOT*100
S @GLOB@("GONT","FEMALE","CNT")=SEX("F")
S @GLOB@("GONT","POS","PERC")=CNT1/GONTOT*100
S @GLOB@("GONT","POS","CNT")=CNT1
S @GLOB@("GONT","NEG","PERC")=CNT2/GONTOT*100
S @GLOB@("GONT","NEG","CNT")=CNT2
S @GLOB@("GONT","UND","PERC")=CNT3/GONTOT*100
S @GLOB@("GONT","UND","CNT")=CNT3
S @GLOB@("GONT","REF","PERC")=CNT4/GONTOT*100
S @GLOB@("GONT","REF","CNT")=CNT4
S @GLOB@("GONT","REFNMI","PERC")=CNT5/GONTOT*100
S @GLOB@("GONT","REFNMI","CNT")=CNT5
Q
TBCALC ; EP - Tuberculosis Calculation
N PTOTAL,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7,FOUND,CHKDT,TEST,RESULT
;I $G(@GLOB@("HIVCHK","TBT21PTCNT"))<1 Q
S PTOTAL=$G(@GLOB@("HIVTOT1"))
S CHKDT=$$FMADD^XLFDT(EDATE,-365)
S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7)=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
.I $$T21CHK(BKMDFN)=0 Q ;Patient not in denominator
.S CNT1=CNT1+1,FOUND=0 ;Patient needed PPD
.D ; Only required to check most recent visit (unlike other sections of this report)
..S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21",""),-1) Q:VSTDT=""
..I VSTDT<CHKDT Q ; Only check visits from the previous year.
..; Only skin test and LOINC results are examined
..S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,""),-1) ;Must be a visit at this level.
..S FOUND=1
..S CNT2=CNT2+1 ;PPD Received
..I TEST="" S CNT5=CNT5+1 Q ; If last TB test was not a skin test or LOINC -> PPD undetermined
..S RESULT=$G(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
..I $$POS(RESULT) S CNT3=CNT3+1 D Q ; PPD positive
...I $O(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",""),-1)'<(VSTDT\1) S CNT7=CNT7+1 ; Meds given (or refused) on or after PPD positive
...Q
..I $$NEG(RESULT) S CNT4=CNT4+1 Q ; PPD negative
..S CNT5=CNT5+1 ; PPD undetermined
..Q
.I 'FOUND,$O(@GLOB@("HIVCHK",BKMDFN,"TBT21REF",""),-1)'<CHKDT S CNT2=CNT2+1,CNT6=CNT6+1 ; PPD refused (also counts as received)
.Q
S @GLOB@("TUBT","NEEDPPD","CNT")=CNT1
I 'PTOTAL S @GLOB@("TUBT","NEEDPPD","PERC")=0
I PTOTAL S @GLOB@("TUBT","NEEDPPD","PERC")=CNT1/PTOTAL*100
S @GLOB@("TUBT","PY","CNT")=CNT2
S @GLOB@("TUBT","PY","PERC")=$S('CNT1:0,1:CNT2/CNT1)*100
S @GLOB@("TUBT","POSPY","CNT")=CNT3
S @GLOB@("TUBT","POSPY","PERC")=$S('CNT2:0,1:CNT3/CNT2)*100
S @GLOB@("TUBT","MED","CNT")=CNT7
S @GLOB@("TUBT","MED","PERC")=$S('CNT3:0,1:CNT7/CNT3)*100
S @GLOB@("TUBT","NEGPY","CNT")=CNT4
S @GLOB@("TUBT","NEGPY","PERC")=$S('CNT2:0,1:CNT4/CNT2)*100
S @GLOB@("TUBT","REF","CNT")=CNT6
S @GLOB@("TUBT","REF","PERC")=$S('CNT2:0,1:CNT6/CNT2)*100
S @GLOB@("TUBT","UND","CNT")=CNT5
S @GLOB@("TUBT","UND","PERC")=$S('CNT2:0,1:CNT5/CNT2)*100
Q
T21CHK(BKMDFN) ; Checks to see if patient needs a PPD test.
;
; Returns 1 (TRUE) if patient has never had a TB diagnosis through Report End Date (EDATE).
; Returns 1 (TRUE) if patient has never had a PPD test through Report End Date (EDATE).
; Returns 1 (TRUE) if patient does not have a positive PPD prior to one year before Report End Date (EDATE).
; Returns 1 (TRUE) if patient has no TB medication (or refusal) prior to one year before Report End Date (EDATE).
;
N VSTDT,TRUE,HVSTDT,TEST,RESULT
S VSTDT=0,TRUE=1
I $D(@GLOB@("HIVCHK",BKMDFN,"TBT21DX")) S TRUE=0
F S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21",VSTDT)) Q:VSTDT="" D
.I VSTDT'<CHKDT Q ; Don't check visits from the previous year.
.S TEST=0
.F S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST)) Q:TEST="" D
..S RESULT=$G(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
..I $$POS(RESULT) S TRUE=0 Q
..Q
.Q
I $O(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",CHKDT),-1)'="" S TRUE=0
Q TRUE
; Note: For the following two functions, you will receive either a 'result' or a 'reading'.
; Except, if this is from a skin taxonomy, then you will receive 'reading^result'.
; Where both items are available, check result.
; Only check for reading if result is not available.
POS(PPD) ; Return 1 if the PPD result is 'positive'. If no result, return 1 if reading is >= 5mm.
N RES
S RES=0
I $L(PPD,U)=1 D
. I $$PPDPOS^BKMVF32(PPD) S RES=1 Q
. ;I $$POSITIVE^BKMVF32(PPD) S RES=1 Q
. I +PPD'<5,$P(PPD,"^")'="" S RES=1 Q
I $L(PPD,U)=2 D
. I $P(PPD,U,2)]"" S:$$PPDPOS^BKMVF32($P(PPD,U,2)) RES=1 Q
. ;I $P(PPD,U,2)]"" S:$$POSITIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
. I +PPD'<5,$P(PPD,"^")'="" S RES=1 Q
Q RES
NEG(PPD) ; Return 1 if the PPD result is 'negative'. If no result, return 1 if reading is < 5 mm.
; NOTE: 'NULL' is not a negative, '0' is.
N RES
S RES=0
I $L(PPD,U)=1 D
. I $$PPDNEG^BKMVF32(PPD) S RES=1 Q
. ;I $$NEGATIVE^BKMVF32(PPD) S RES=1 Q
. I +PPD<5,$P(PPD,"^")'="" S RES=1 Q
I $L(PPD,U)=2 D
. I $P(PPD,U,2)]"" S:$$PPDNEG^BKMVF32($P(PPD,U,2)) RES=1 Q
. ;I $P(PPD,U,2)]"" S:$$NEGATIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
. I +PPD<5,$P(PPD,"^")'="" S RES=1 Q
Q RES
SEX(DFN) ; Return the patient's sex
Q $$GET1^DIQ(2,DFN,.02,"I")
BKMQQCR7 ;PRXM/HC/BWF - BKMV Quality of Care Report; [ 1/19/2005 7:16 PM ] ; 10 May 2005 4:12 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ; Quality of Care Audit Report
+3 QUIT
CHLAMC ; EP - Chlamydia Calculation
+1 NEW CNT1,CNT2,CNT3,CNT4,CNT5,CHLTOT,BKMDFN,VSTDT,TEST,CHLRES,FMDT,ITEM,FOUND,PTOTAL
+2 NEW DFNSTAT,REFVSTDT,SEX
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET CHLTOT=$GET(@GLOB@("HIVCHK","CHLAMPTCNT"))
+5 IF CHLTOT=0!(CHLTOT="")
QUIT
+6 SET BKMDFN=0
SET (CNT1,CNT2,CNT3,CNT4,CNT5)=0
SET SEX("M")=""
SET SEX("F")=""
+7 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+8 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CHLAM"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF"))
QUIT
+9 SET SEX=$$SEX(BKMDFN)
IF SEX'=""
SET SEX(SEX)=SEX(SEX)+1
+10 SET VSTDT=""
SET FOUND=0
SET DFNSTAT=0
+11 SET REFVSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",""),-1)
+12 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT),-1)
IF VSTDT=""
QUIT
Begin DoDot:2
+13 SET TEST=""
+14 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST),-1)
IF TEST=""
QUIT
Begin DoDot:3
+15 SET CHLRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST)),U)
+16 IF $$POSITIVE^BKMVF32(CHLRES)
SET DFNSTAT=1
SET FOUND=1
QUIT
+17 IF $$NEGATIVE^BKMVF32(CHLRES)
SET DFNSTAT=2
SET FOUND=1
QUIT
End DoDot:3
IF FOUND
QUIT
End DoDot:2
IF FOUND
QUIT
+18 Begin DoDot:2
+19 IF REFVSTDT'=""
IF REFVSTDT>VSTDT
Begin DoDot:3
+20 SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,""),-1)
+21 SET CHLRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,TEST)),U)
+22 IF $PIECE(CHLRES,"^")="NOT MEDICALLY INDICATED"
SET CNT5=CNT5+1
QUIT
+23 SET CNT4=CNT4+1
End DoDot:3
QUIT
+24 IF DFNSTAT=1
SET CNT1=CNT1+1
QUIT
+25 IF DFNSTAT=2
SET CNT2=CNT2+1
QUIT
+26 SET CNT3=CNT3+1
End DoDot:2
End DoDot:1
+27 SET @GLOB@("CHLAMT","TOTAL","PERC")=CHLTOT/PTOTAL*100
+28 SET @GLOB@("CHLAMT","TOTAL","CNT")=CHLTOT
+29 SET @GLOB@("CHLAMT","MALE","PERC")=SEX("M")/CHLTOT*100
+30 SET @GLOB@("CHLAMT","MALE","CNT")=SEX("M")
+31 SET @GLOB@("CHLAMT","FEMALE","PERC")=SEX("F")/CHLTOT*100
+32 SET @GLOB@("CHLAMT","FEMALE","CNT")=SEX("F")
+33 SET @GLOB@("CHLAMT","POS","PERC")=CNT1/CHLTOT*100
+34 SET @GLOB@("CHLAMT","POS","CNT")=CNT1
+35 SET @GLOB@("CHLAMT","NEG","PERC")=CNT2/CHLTOT*100
+36 SET @GLOB@("CHLAMT","NEG","CNT")=CNT2
+37 SET @GLOB@("CHLAMT","UND","PERC")=CNT3/CHLTOT*100
+38 SET @GLOB@("CHLAMT","UND","CNT")=CNT3
+39 SET @GLOB@("CHLAMT","REF","PERC")=CNT4/CHLTOT*100
+40 SET @GLOB@("CHLAMT","REF","CNT")=CNT4
+41 SET @GLOB@("CHLAMT","REFNMI","PERC")=CNT5/CHLTOT*100
+42 SET @GLOB@("CHLAMT","REFNMI","CNT")=CNT5
+43 QUIT
GONCALC ; EP - Gonorrhea Calculation
+1 NEW CNT1,CNT2,CNT3,CNT4,CNT5,GONTOT,BKMDFN,VSTDT,TEST,GONRES,FMDT,ITEM,FOUND,PTOTAL
+2 NEW DFNSTAT,REFVSTDT
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET GONTOT=$GET(@GLOB@("HIVCHK","GONPTCNT"))
+5 IF GONTOT=0!(GONTOT="")
QUIT
+6 SET BKMDFN=0
SET (CNT1,CNT2,CNT3,CNT4,CNT5)=0
SET SEX("M")=""
SET SEX("F")=""
+7 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+8 IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"GON"))
IF '$DATA(@GLOB@("HIVCHK",BKMDFN,"GONREF"))
QUIT
+9 SET SEX=$$SEX(BKMDFN)
IF SEX'=""
SET SEX(SEX)=SEX(SEX)+1
+10 SET VSTDT=""
SET FOUND=0
SET DFNSTAT=0
+11 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT),-1)
IF VSTDT=""
QUIT
Begin DoDot:2
+12 SET TEST=""
+13 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST),-1)
IF TEST=""
QUIT
Begin DoDot:3
+14 SET GONRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST)),U)
+15 IF $$POSITIVE^BKMVF32(GONRES)
SET DFNSTAT=1
SET FOUND=1
QUIT
+16 IF $$NEGATIVE^BKMVF32(GONRES)
SET DFNSTAT=2
SET FOUND=1
QUIT
End DoDot:3
IF FOUND
QUIT
End DoDot:2
IF FOUND
QUIT
+17 SET REFVSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"GONREF",""),-1)
+18 Begin DoDot:2
+19 IF REFVSTDT'=""
IF REFVSTDT>VSTDT
Begin DoDot:3
+20 SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,""),-1)
+21 SET GONRES=$PIECE($GET(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,TEST)),U)
+22 IF $PIECE(GONRES,"^")="NOT MEDICALLY INDICATED"
SET CNT5=CNT5+1
QUIT
+23 SET CNT4=CNT4+1
End DoDot:3
QUIT
+24 IF DFNSTAT=1
SET CNT1=CNT1+1
QUIT
+25 IF DFNSTAT=2
SET CNT2=CNT2+1
QUIT
+26 SET CNT3=CNT3+1
End DoDot:2
End DoDot:1
+27 SET @GLOB@("GONT","TOTAL","PERC")=GONTOT/PTOTAL*100
+28 SET @GLOB@("GONT","TOTAL","CNT")=GONTOT
+29 SET @GLOB@("GONT","MALE","PERC")=SEX("M")/GONTOT*100
+30 SET @GLOB@("GONT","MALE","CNT")=SEX("M")
+31 SET @GLOB@("GONT","FEMALE","PERC")=SEX("F")/GONTOT*100
+32 SET @GLOB@("GONT","FEMALE","CNT")=SEX("F")
+33 SET @GLOB@("GONT","POS","PERC")=CNT1/GONTOT*100
+34 SET @GLOB@("GONT","POS","CNT")=CNT1
+35 SET @GLOB@("GONT","NEG","PERC")=CNT2/GONTOT*100
+36 SET @GLOB@("GONT","NEG","CNT")=CNT2
+37 SET @GLOB@("GONT","UND","PERC")=CNT3/GONTOT*100
+38 SET @GLOB@("GONT","UND","CNT")=CNT3
+39 SET @GLOB@("GONT","REF","PERC")=CNT4/GONTOT*100
+40 SET @GLOB@("GONT","REF","CNT")=CNT4
+41 SET @GLOB@("GONT","REFNMI","PERC")=CNT5/GONTOT*100
+42 SET @GLOB@("GONT","REFNMI","CNT")=CNT5
+43 QUIT
TBCALC ; EP - Tuberculosis Calculation
+1 NEW PTOTAL,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7,FOUND,CHKDT,TEST,RESULT
+2 ;I $G(@GLOB@("HIVCHK","TBT21PTCNT"))<1 Q
+3 SET PTOTAL=$GET(@GLOB@("HIVTOT1"))
+4 SET CHKDT=$$FMADD^XLFDT(EDATE,-365)
+5 SET BKMDFN=0
SET (CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7)=0
+6 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+7 ;Patient not in denominator
IF $$T21CHK(BKMDFN)=0
QUIT
+8 ;Patient needed PPD
SET CNT1=CNT1+1
SET FOUND=0
+9 ; Only required to check most recent visit (unlike other sections of this report)
Begin DoDot:2
+10 SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21",""),-1)
IF VSTDT=""
QUIT
+11 ; Only check visits from the previous year.
IF VSTDT<CHKDT
QUIT
+12 ; Only skin test and LOINC results are examined
+13 ;Must be a visit at this level.
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,""),-1)
+14 SET FOUND=1
+15 ;PPD Received
SET CNT2=CNT2+1
+16 ; If last TB test was not a skin test or LOINC -> PPD undetermined
IF TEST=""
SET CNT5=CNT5+1
QUIT
+17 SET RESULT=$GET(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
+18 ; PPD positive
IF $$POS(RESULT)
SET CNT3=CNT3+1
Begin DoDot:3
+19 ; Meds given (or refused) on or after PPD positive
IF $ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",""),-1)'<(VSTDT\1)
SET CNT7=CNT7+1
+20 QUIT
End DoDot:3
QUIT
+21 ; PPD negative
IF $$NEG(RESULT)
SET CNT4=CNT4+1
QUIT
+22 ; PPD undetermined
SET CNT5=CNT5+1
+23 QUIT
End DoDot:2
+24 ; PPD refused (also counts as received)
IF 'FOUND
IF $ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21REF",""),-1)'<CHKDT
SET CNT2=CNT2+1
SET CNT6=CNT6+1
+25 QUIT
End DoDot:1
+26 SET @GLOB@("TUBT","NEEDPPD","CNT")=CNT1
+27 IF 'PTOTAL
SET @GLOB@("TUBT","NEEDPPD","PERC")=0
+28 IF PTOTAL
SET @GLOB@("TUBT","NEEDPPD","PERC")=CNT1/PTOTAL*100
+29 SET @GLOB@("TUBT","PY","CNT")=CNT2
+30 SET @GLOB@("TUBT","PY","PERC")=$SELECT('CNT1:0,1:CNT2/CNT1)*100
+31 SET @GLOB@("TUBT","POSPY","CNT")=CNT3
+32 SET @GLOB@("TUBT","POSPY","PERC")=$SELECT('CNT2:0,1:CNT3/CNT2)*100
+33 SET @GLOB@("TUBT","MED","CNT")=CNT7
+34 SET @GLOB@("TUBT","MED","PERC")=$SELECT('CNT3:0,1:CNT7/CNT3)*100
+35 SET @GLOB@("TUBT","NEGPY","CNT")=CNT4
+36 SET @GLOB@("TUBT","NEGPY","PERC")=$SELECT('CNT2:0,1:CNT4/CNT2)*100
+37 SET @GLOB@("TUBT","REF","CNT")=CNT6
+38 SET @GLOB@("TUBT","REF","PERC")=$SELECT('CNT2:0,1:CNT6/CNT2)*100
+39 SET @GLOB@("TUBT","UND","CNT")=CNT5
+40 SET @GLOB@("TUBT","UND","PERC")=$SELECT('CNT2:0,1:CNT5/CNT2)*100
+41 QUIT
T21CHK(BKMDFN) ; Checks to see if patient needs a PPD test.
+1 ;
+2 ; Returns 1 (TRUE) if patient has never had a TB diagnosis through Report End Date (EDATE).
+3 ; Returns 1 (TRUE) if patient has never had a PPD test through Report End Date (EDATE).
+4 ; Returns 1 (TRUE) if patient does not have a positive PPD prior to one year before Report End Date (EDATE).
+5 ; Returns 1 (TRUE) if patient has no TB medication (or refusal) prior to one year before Report End Date (EDATE).
+6 ;
+7 NEW VSTDT,TRUE,HVSTDT,TEST,RESULT
+8 SET VSTDT=0
SET TRUE=1
+9 IF $DATA(@GLOB@("HIVCHK",BKMDFN,"TBT21DX"))
SET TRUE=0
+10 FOR
SET VSTDT=$ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21",VSTDT))
IF VSTDT=""
QUIT
Begin DoDot:1
+11 ; Don't check visits from the previous year.
IF VSTDT'<CHKDT
QUIT
+12 SET TEST=0
+13 FOR
SET TEST=$ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
IF TEST=""
QUIT
Begin DoDot:2
+14 SET RESULT=$GET(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
+15 IF $$POS(RESULT)
SET TRUE=0
QUIT
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 IF $ORDER(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",CHKDT),-1)'=""
SET TRUE=0
+19 QUIT TRUE
+20 ; Note: For the following two functions, you will receive either a 'result' or a 'reading'.
+21 ; Except, if this is from a skin taxonomy, then you will receive 'reading^result'.
+22 ; Where both items are available, check result.
+23 ; Only check for reading if result is not available.
POS(PPD) ; Return 1 if the PPD result is 'positive'. If no result, return 1 if reading is >= 5mm.
+1 NEW RES
+2 SET RES=0
+3 IF $LENGTH(PPD,U)=1
Begin DoDot:1
+4 IF $$PPDPOS^BKMVF32(PPD)
SET RES=1
QUIT
+5 ;I $$POSITIVE^BKMVF32(PPD) S RES=1 Q
+6 IF +PPD'<5
IF $PIECE(PPD,"^")'=""
SET RES=1
QUIT
End DoDot:1
+7 IF $LENGTH(PPD,U)=2
Begin DoDot:1
+8 IF $PIECE(PPD,U,2)]""
IF $$PPDPOS^BKMVF32($PIECE(PPD,U,2))
SET RES=1
QUIT
+9 ;I $P(PPD,U,2)]"" S:$$POSITIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
+10 IF +PPD'<5
IF $PIECE(PPD,"^")'=""
SET RES=1
QUIT
End DoDot:1
+11 QUIT RES
NEG(PPD) ; Return 1 if the PPD result is 'negative'. If no result, return 1 if reading is < 5 mm.
+1 ; NOTE: 'NULL' is not a negative, '0' is.
+2 NEW RES
+3 SET RES=0
+4 IF $LENGTH(PPD,U)=1
Begin DoDot:1
+5 IF $$PPDNEG^BKMVF32(PPD)
SET RES=1
QUIT
+6 ;I $$NEGATIVE^BKMVF32(PPD) S RES=1 Q
+7 IF +PPD<5
IF $PIECE(PPD,"^")'=""
SET RES=1
QUIT
End DoDot:1
+8 IF $LENGTH(PPD,U)=2
Begin DoDot:1
+9 IF $PIECE(PPD,U,2)]""
IF $$PPDNEG^BKMVF32($PIECE(PPD,U,2))
SET RES=1
QUIT
+10 ;I $P(PPD,U,2)]"" S:$$NEGATIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
+11 IF +PPD<5
IF $PIECE(PPD,"^")'=""
SET RES=1
QUIT
End DoDot:1
+12 QUIT RES
SEX(DFN) ; Return the patient's sex
+1 QUIT $$GET1^DIQ(2,DFN,.02,"I")
