Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BKMQQCR7

BKMQQCR7.m

Go to the documentation of this file. 
  1. 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
  1.  ; Quality of Care Audit Report
  1.  Q
  1. CHLAMC ; EP - Chlamydia Calculation
  1.  N CNT1,CNT2,CNT3,CNT4,CNT5,CHLTOT,BKMDFN,VSTDT,TEST,CHLRES,FMDT,ITEM,FOUND,PTOTAL
  1.  N DFNSTAT,REFVSTDT,SEX
  1.  S PTOTAL=$G(@GLOB@("HIVTOT1"))
  1.  S CHLTOT=$G(@GLOB@("HIVCHK","CHLAMPTCNT"))
  1.  I CHLTOT=0!(CHLTOT="") Q
  1.  S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5)=0,SEX("M")="",SEX("F")=""
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .I '$D(@GLOB@("HIVCHK",BKMDFN,"CHLAM")),'$D(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF")) Q
  1.  .S SEX=$$SEX(BKMDFN) I SEX'="" S SEX(SEX)=SEX(SEX)+1
  1.  .S VSTDT="",FOUND=0,DFNSTAT=0
  1.  .S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",""),-1)
  1.  .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT),-1) Q:VSTDT=""  D  Q:FOUND
  1.  ..S TEST=""
  1.  ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST),-1) Q:TEST=""  D  Q:FOUND
  1.  ...S CHLRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"CHLAM",VSTDT,TEST)),U)
  1.  ...I $$POSITIVE^BKMVF32(CHLRES) S DFNSTAT=1,FOUND=1 Q
  1.  ...I $$NEGATIVE^BKMVF32(CHLRES) S DFNSTAT=2,FOUND=1 Q
  1.  .D
  1.  ..I REFVSTDT'="",REFVSTDT>VSTDT D  Q
  1.  ...S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,""),-1)
  1.  ...S CHLRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"CHLAMREF",REFVSTDT,TEST)),U)
  1.  ...I $P(CHLRES,"^")="NOT MEDICALLY INDICATED" S CNT5=CNT5+1 Q
  1.  ...S CNT4=CNT4+1
  1.  ..I DFNSTAT=1 S CNT1=CNT1+1 Q
  1.  ..I DFNSTAT=2 S CNT2=CNT2+1 Q
  1.  ..S CNT3=CNT3+1
  1.  S @GLOB@("CHLAMT","TOTAL","PERC")=CHLTOT/PTOTAL*100
  1.  S @GLOB@("CHLAMT","TOTAL","CNT")=CHLTOT
  1.  S @GLOB@("CHLAMT","MALE","PERC")=SEX("M")/CHLTOT*100
  1.  S @GLOB@("CHLAMT","MALE","CNT")=SEX("M")
  1.  S @GLOB@("CHLAMT","FEMALE","PERC")=SEX("F")/CHLTOT*100
  1.  S @GLOB@("CHLAMT","FEMALE","CNT")=SEX("F")
  1.  S @GLOB@("CHLAMT","POS","PERC")=CNT1/CHLTOT*100
  1.  S @GLOB@("CHLAMT","POS","CNT")=CNT1
  1.  S @GLOB@("CHLAMT","NEG","PERC")=CNT2/CHLTOT*100
  1.  S @GLOB@("CHLAMT","NEG","CNT")=CNT2
  1.  S @GLOB@("CHLAMT","UND","PERC")=CNT3/CHLTOT*100
  1.  S @GLOB@("CHLAMT","UND","CNT")=CNT3
  1.  S @GLOB@("CHLAMT","REF","PERC")=CNT4/CHLTOT*100
  1.  S @GLOB@("CHLAMT","REF","CNT")=CNT4
  1.  S @GLOB@("CHLAMT","REFNMI","PERC")=CNT5/CHLTOT*100
  1.  S @GLOB@("CHLAMT","REFNMI","CNT")=CNT5
  1.  Q
  1. GONCALC ; EP - Gonorrhea Calculation
  1.  N CNT1,CNT2,CNT3,CNT4,CNT5,GONTOT,BKMDFN,VSTDT,TEST,GONRES,FMDT,ITEM,FOUND,PTOTAL
  1.  N DFNSTAT,REFVSTDT
  1.  S PTOTAL=$G(@GLOB@("HIVTOT1"))
  1.  S GONTOT=$G(@GLOB@("HIVCHK","GONPTCNT"))
  1.  I GONTOT=0!(GONTOT="") Q
  1.  S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5)=0,SEX("M")="",SEX("F")=""
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .I '$D(@GLOB@("HIVCHK",BKMDFN,"GON")),'$D(@GLOB@("HIVCHK",BKMDFN,"GONREF")) Q
  1.  .S SEX=$$SEX(BKMDFN) I SEX'="" S SEX(SEX)=SEX(SEX)+1
  1.  .S VSTDT="",FOUND=0,DFNSTAT=0
  1.  .F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT),-1) Q:VSTDT=""  D  Q:FOUND
  1.  ..S TEST=""
  1.  ..F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST),-1) Q:TEST=""  D  Q:FOUND
  1.  ...S GONRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"GON",VSTDT,TEST)),U)
  1.  ...I $$POSITIVE^BKMVF32(GONRES) S DFNSTAT=1,FOUND=1 Q
  1.  ...I $$NEGATIVE^BKMVF32(GONRES) S DFNSTAT=2,FOUND=1 Q
  1.  .S REFVSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"GONREF",""),-1)
  1.  .D
  1.  ..I REFVSTDT'="",REFVSTDT>VSTDT D  Q
  1.  ...S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,""),-1)
  1.  ...S GONRES=$P($G(@GLOB@("HIVCHK",BKMDFN,"GONREF",REFVSTDT,TEST)),U)
  1.  ...I $P(GONRES,"^")="NOT MEDICALLY INDICATED" S CNT5=CNT5+1 Q
  1.  ...S CNT4=CNT4+1
  1.  ..I DFNSTAT=1 S CNT1=CNT1+1 Q
  1.  ..I DFNSTAT=2 S CNT2=CNT2+1 Q
  1.  ..S CNT3=CNT3+1
  1.  S @GLOB@("GONT","TOTAL","PERC")=GONTOT/PTOTAL*100
  1.  S @GLOB@("GONT","TOTAL","CNT")=GONTOT
  1.  S @GLOB@("GONT","MALE","PERC")=SEX("M")/GONTOT*100
  1.  S @GLOB@("GONT","MALE","CNT")=SEX("M")
  1.  S @GLOB@("GONT","FEMALE","PERC")=SEX("F")/GONTOT*100
  1.  S @GLOB@("GONT","FEMALE","CNT")=SEX("F")
  1.  S @GLOB@("GONT","POS","PERC")=CNT1/GONTOT*100
  1.  S @GLOB@("GONT","POS","CNT")=CNT1
  1.  S @GLOB@("GONT","NEG","PERC")=CNT2/GONTOT*100
  1.  S @GLOB@("GONT","NEG","CNT")=CNT2
  1.  S @GLOB@("GONT","UND","PERC")=CNT3/GONTOT*100
  1.  S @GLOB@("GONT","UND","CNT")=CNT3
  1.  S @GLOB@("GONT","REF","PERC")=CNT4/GONTOT*100
  1.  S @GLOB@("GONT","REF","CNT")=CNT4
  1.  S @GLOB@("GONT","REFNMI","PERC")=CNT5/GONTOT*100
  1.  S @GLOB@("GONT","REFNMI","CNT")=CNT5
  1.  Q
  1. TBCALC ; EP - Tuberculosis Calculation 
  1.  N PTOTAL,BKMDFN,CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7,FOUND,CHKDT,TEST,RESULT
  1.  ;I $G(@GLOB@("HIVCHK","TBT21PTCNT"))<1 Q
  1.  S PTOTAL=$G(@GLOB@("HIVTOT1"))
  1.  S CHKDT=$$FMADD^XLFDT(EDATE,-365)
  1.  S BKMDFN=0,(CNT1,CNT2,CNT3,CNT4,CNT5,CNT6,CNT7)=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  .I $$T21CHK(BKMDFN)=0 Q  ;Patient not in denominator
  1.  .S CNT1=CNT1+1,FOUND=0 ;Patient needed PPD
  1.  .D  ; Only required to check most recent visit (unlike other sections of this report)
  1.  ..S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21",""),-1) Q:VSTDT=""
  1.  ..I VSTDT<CHKDT Q  ; Only check visits from the previous year.
  1.  ..; Only skin test and LOINC results are examined
  1.  ..S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,""),-1) ;Must be a visit at this level.
  1.  ..S FOUND=1
  1.  ..S CNT2=CNT2+1 ;PPD Received
  1.  ..I TEST="" S CNT5=CNT5+1 Q  ; If last TB test was not a skin test or LOINC -> PPD undetermined
  1.  ..S RESULT=$G(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
  1.  ..I $$POS(RESULT) S CNT3=CNT3+1 D  Q  ; PPD positive
  1.  ...I $O(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",""),-1)'<(VSTDT\1) S CNT7=CNT7+1 ; Meds given (or refused) on or after PPD positive
  1.  ...Q
  1.  ..I $$NEG(RESULT) S CNT4=CNT4+1 Q  ; PPD negative
  1.  ..S CNT5=CNT5+1 ; PPD undetermined
  1.  ..Q
  1.  .I 'FOUND,$O(@GLOB@("HIVCHK",BKMDFN,"TBT21REF",""),-1)'<CHKDT S CNT2=CNT2+1,CNT6=CNT6+1 ; PPD refused (also counts as received)
  1.  .Q
  1.  S @GLOB@("TUBT","NEEDPPD","CNT")=CNT1
  1.  I 'PTOTAL S @GLOB@("TUBT","NEEDPPD","PERC")=0
  1.  I PTOTAL S @GLOB@("TUBT","NEEDPPD","PERC")=CNT1/PTOTAL*100
  1.  S @GLOB@("TUBT","PY","CNT")=CNT2
  1.  S @GLOB@("TUBT","PY","PERC")=$S('CNT1:0,1:CNT2/CNT1)*100
  1.  S @GLOB@("TUBT","POSPY","CNT")=CNT3
  1.  S @GLOB@("TUBT","POSPY","PERC")=$S('CNT2:0,1:CNT3/CNT2)*100
  1.  S @GLOB@("TUBT","MED","CNT")=CNT7
  1.  S @GLOB@("TUBT","MED","PERC")=$S('CNT3:0,1:CNT7/CNT3)*100
  1.  S @GLOB@("TUBT","NEGPY","CNT")=CNT4
  1.  S @GLOB@("TUBT","NEGPY","PERC")=$S('CNT2:0,1:CNT4/CNT2)*100
  1.  S @GLOB@("TUBT","REF","CNT")=CNT6
  1.  S @GLOB@("TUBT","REF","PERC")=$S('CNT2:0,1:CNT6/CNT2)*100
  1.  S @GLOB@("TUBT","UND","CNT")=CNT5
  1.  S @GLOB@("TUBT","UND","PERC")=$S('CNT2:0,1:CNT5/CNT2)*100
  1.  Q
  1. T21CHK(BKMDFN) ; Checks to see if patient needs a PPD test.
  1.  ;
  1.  ; Returns 1 (TRUE) if patient has never had a TB diagnosis through Report End Date (EDATE).
  1.  ; Returns 1 (TRUE) if patient has never had a PPD test through Report End Date (EDATE).
  1.  ; Returns 1 (TRUE) if patient does not have a positive PPD prior to one year before Report End Date (EDATE).
  1.  ; Returns 1 (TRUE) if patient has no TB medication (or refusal) prior to one year before Report End Date (EDATE).
  1.  ;
  1.  N VSTDT,TRUE,HVSTDT,TEST,RESULT
  1.  S VSTDT=0,TRUE=1
  1.  I $D(@GLOB@("HIVCHK",BKMDFN,"TBT21DX")) S TRUE=0
  1.  F  S VSTDT=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21",VSTDT)) Q:VSTDT=""  D
  1.  .I VSTDT'<CHKDT Q  ; Don't check visits from the previous year.
  1.  .S TEST=0
  1.  .F  S TEST=$O(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST)) Q:TEST=""  D
  1.  ..S RESULT=$G(@GLOB@("HIVCHK",BKMDFN,"TBT21POSNEG",VSTDT,TEST))
  1.  ..I $$POS(RESULT) S TRUE=0 Q
  1.  ..Q
  1.  .Q
  1.  I $O(@GLOB@("HIVCHK",BKMDFN,"TBT21MED",CHKDT),-1)'="" S TRUE=0
  1.  Q TRUE
  1.  ; Note: For the following two functions, you will receive either a 'result' or a 'reading'.
  1.  ;       Except, if this is from a skin taxonomy, then you will receive 'reading^result'.
  1.  ;       Where both items are available, check result.
  1.  ;       Only check for reading if result is not available.
  1. POS(PPD) ; Return 1 if the PPD result is 'positive'. If no result, return 1 if reading is >= 5mm.
  1.  N RES
  1.  S RES=0
  1.  I $L(PPD,U)=1 D
  1.  . I $$PPDPOS^BKMVF32(PPD) S RES=1 Q
  1.  . ;I $$POSITIVE^BKMVF32(PPD) S RES=1 Q
  1.  . I +PPD'<5,$P(PPD,"^")'="" S RES=1 Q
  1.  I $L(PPD,U)=2 D
  1.  . I $P(PPD,U,2)]"" S:$$PPDPOS^BKMVF32($P(PPD,U,2)) RES=1 Q
  1.  . ;I $P(PPD,U,2)]"" S:$$POSITIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
  1.  . I +PPD'<5,$P(PPD,"^")'="" S RES=1 Q
  1.  Q RES
  1. 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.
  1.  N RES
  1.  S RES=0
  1.  I $L(PPD,U)=1 D
  1.  . I $$PPDNEG^BKMVF32(PPD) S RES=1 Q
  1.  . ;I $$NEGATIVE^BKMVF32(PPD) S RES=1 Q
  1.  . I +PPD<5,$P(PPD,"^")'="" S RES=1 Q
  1.  I $L(PPD,U)=2 D
  1.  . I $P(PPD,U,2)]"" S:$$PPDNEG^BKMVF32($P(PPD,U,2)) RES=1 Q
  1.  . ;I $P(PPD,U,2)]"" S:$$NEGATIVE^BKMVF32($P(PPD,U,2)) RES=1 Q
  1.  . I +PPD<5,$P(PPD,"^")'="" S RES=1 Q
  1.  Q RES
  1. SEX(DFN) ; Return the patient's sex
  1.  Q $$GET1^DIQ(2,DFN,.02,"I")