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

BGPMUD08.m

Go to the documentation of this file. 
  1. BGPMUD08 ; IHS/MSC/SAT - MI measure NQF0033 ;25-AUG-2011 14:56
  1.  ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
  1.  ;
  1.  ; BGPMUD01 = tobacco use assessment               0028a
  1.  ; BGPMUD02 = tobacco use cessation                0028b
  1.  ; BGPMUD03 = Heart Failure w/ACE Inhibitor or ARB 0081
  1.  ; BGPMUD04 = Prenatal HIV Screening               0012
  1.  ; BGPMUD05 = Prenatal Anti-D Immune Globulin      0014
  1.  ; BGPMUD06 = Control High Blood Pressure          0018
  1.  ; BGPMUD07 = SMOKING CESSATION MEDICAL ASSIST     0027
  1.  ; BGPMUD08 = Chlamydia Measure                    0033
  1.  ; BGPMUD09 = Antidepressant Medication Management 0105
  1.  ; BGPMUD10 = Oncology Colon Cancer Stage III      0385
  1.  ;
  1.  ;Code to collect meaningful use report for Chlamydia Measure 0033
  1. ENTRY ;EP
  1.  N START,END,BGPNUM,STRING,STRING2
  1.  N IEN,INV,RFOUND,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN
  1.  N CNT,DIAB,NUM,DIAB,DIABDX,OUTENC,OPHENC,NONENC,VENC,INENC,ERENC
  1.  N BGPALL,BGPAR,BGPEXC,BGPH
  1.  ; BGPDEN1 = ages 15-24
  1.  ; BGPDEN2 = ages 15-19
  1.  ; BGPDEN3 = ages 20-24
  1.  S (BGPDEN1,BGPDEN2,BGPDEN3,BGPEXC,BGPNUM,BGPNOT)=""
  1.  S BGPALL=""
  1.  S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
  1.  S START=START_".2359"
  1.  ;only check female
  1.  S BGPSEX=$$SEX^AUPNPAT(DFN)
  1.  Q:BGPSEX'="F"
  1.  ;Pts must be >=15 and <=24
  1.  S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
  1.  S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
  1.  ;No need to check further if no age match
  1.  Q:BGPAGEE<15!(BGPAGEB>24)  ;determine if the patient was between 15 & 24 yrs during the reporting period
  1.  S X=0
  1.  ;look for 1 outpatient encounter with the EP back to 365 days prior to the end of the reporting period
  1.  S START=9999999-$$FMADD^XLFDT(BGPEDATE,-365),END=9999999-BGPEDATE
  1.  S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D  Q:+X
  1.  .S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN  D  Q:+X
  1.  ..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
  1.  ..;Check provider, determine if there are visits with E&M codes
  1.  ..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
  1.  ...S X=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENCOUNTER OUTPT")
  1.  ...I '+X S X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ENC OUTPATIENT ICD")
  1.  ;
  1.  Q:'+X  ;quit if no encounter found
  1.  ;check if sexually active
  1.  S X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM CPT")
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
  1.  S X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM ICD0")
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
  1.  ;check for pregnancy
  1.  K LABDATA
  1.  D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
  1.  I +LABDATA S X=$S($P(LABDATA,U,5)'="":$P($P(LABDATA,U,5),".",1),$P(LABDATA,U,2)'="":$P($P(LABDATA,U,2),".",1),1:BGPDT) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"LABP")
  1.  ;check for pregnancy encounter
  1.  S X=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU PREGNANCY ENC ICD")
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PREG")
  1.  ;check lab indicative of sexually active (anytime prior to the report period end date)
  1.  K LABDATA
  1.  D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC SEX ACTIVE FEM","BGPMU LAB CPT SEX ACTIVE FEM",0,BGPEDATE)
  1.  I +LABDATA S X=$S($P(LABDATA,U,5)'="":$P($P(LABDATA,U,5),".",1),$P(LABDATA,U,2)'="":$P($P(LABDATA,U,2),".",1),1:BGPDT) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"LAB")
  1.  ;check VPOV for DX indicative of sexually active (anytime prior to the report period end date)
  1.  S X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM DX")
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"DX")
  1.  ;check PRESCRIPTION for contraceptives
  1.  S X=$$FIND^BGPMUUT8(DFN,"BGPMU CONTRACEPTIVES NDCS",BGPBDATE,"",BGPEDATE,"")
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"MED")
  1.  ;check IUD device use
  1.  S X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU IUD ENC ICD")
  1.  S:'+X X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD ICD0")
  1.  S:'+X X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD CPT")
  1.  I '+X D
  1.  .S BGPIEN=$O(^AUPNREP("B",DFN,""))
  1.  .S BGPRF=$$GET1^DIQ(9000017,BGPIEN_",",3)
  1.  .S:BGPRF="IUD" X=1_U_U_$P(^AUPNREP(BGPIEN,0),U,7)
  1.  I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"IUD")
  1.  ;check PATIENT ALLERGIES for allergy to IUD
  1.  S BGPH="" F  S BGPH=$O(^GMR(120.8,"B",DFN,BGPH)) Q:BGPH=""  D  Q:(BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD")
  1.  .S BGPALL=$P(^GMR(120.8,BGPH,0),U,2)
  1.  .I (BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD") D
  1.  ..S X=$P($P(^GMR(120.8,BGPH,0),U,4),".",1)
  1.  ..D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"ALR")
  1.  ;
  1.  ;check V PATIENT EDUCATION
  1.  S TIEN="" S TIEN=$O(^ATXAX("B","BGPMU CONTRACEPTIVE EDU",0))
  1.  S EIEN="" F  S EIEN=$O(^AUPNVPED("AC",DFN,EIEN)) Q:EIEN=""  D
  1.  .S ETOPIC=$P($G(^AUPNVPED(EIEN,0)),U,1)
  1.  .Q:'ETOPIC
  1.  .Q:'$D(^AUTTEDT(ETOPIC,0))
  1.  .S BGPNMEM=$P($G(^AUTTEDT(ETOPIC,0)),U,2)  ;get mnemonic
  1.  .I BGPNMEM'="" D
  1.  ..I $D(^ATXAX(TIEN,21,"B",BGPNMEM)) D
  1.  ...S EDATE=$P($G(^AUPNVPED(EIEN,12)),U,1)
  1.  ...I EDATE="" S EDATE=BGPDT
  1.  ...S BGPAR(EDATE)=$P(EDATE,".",1)
  1.  I +$D(BGPAR) D
  1.  .S X=$O(BGPAR(0))
  1.  .S X=BGPAR(X)
  1.  .D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"EDU")
  1.  ;
  1.  ;check REPRODUCTIVE FACTORS
  1.  S RFOUND=0
  1.  S EIEN=$O(^AUPNREP("B",DFN,""))
  1.  I EIEN'="" D
  1.  .S BGPREC0=^AUPNREP(EIEN,0)
  1.  .S BGPREC11=$G(^AUPNREP(EIEN,11))
  1.  .S:($P(BGPREC0,U,6)'="")&($P($P(BGPREC0,U,7),".",1)<(BGPEDATE+1)) RFOUND=1
  1.  .I '+RFOUND S:($P(BGPREC11,U,3)&($P($P(BGPREC11,U,4),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,4),".",1)    ;gravida (# of pregnancies)
  1.  .I '+RFOUND S:($P(BGPREC11,U,5)&($P($P(BGPREC11,U,6),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,6),".",1)    ;multiple births
  1.  .I '+RFOUND S:($P(BGPREC11,U,7)&($P($P(BGPREC11,U,8),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,8),".",1)    ;full term births
  1.  .I '+RFOUND S:($P(BGPREC11,U,9)&($P($P(BGPREC11,U,10),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,10),".",1)  ;premature births
  1.  .I '+RFOUND S:($P(BGPREC11,U,11)&($P($P(BGPREC11,U,12),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,12),".",1) ;ectopic pregnancies
  1.  .I '+RFOUND S:($P(BGPREC11,U,13)&($P($P(BGPREC11,U,14),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,14),".",1) ;living children
  1.  .I '+RFOUND S:($P(BGPREC11,U,31)&($P($P(BGPREC11,U,32),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,32),".",1) ;therapeutic abortions
  1.  .I '+RFOUND S:($P(BGPREC11,U,33)&($P($P(BGPREC11,U,34),".",1)<(BGPEDATE+1))) RFOUND=1_U_$P($P(BGPREC11,U,34),".",1) ;spontaneous abortions
  1.  .I +RFOUND D
  1.  ..S X=$P(RFOUND,U,2)
  1.  ..D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"RF")
  1.  ;
  1.  Q:(BGPDEN2="")&(BGPDEN3="")
  1.  D:BGPDEN2'="" DENPOP(DFN,BGPAGEE,BGPDT,.BGPDEN2,"","EN")
  1.  D:BGPDEN3'="" DENPOP(DFN,BGPAGEE,BGPDT,"",.BGPDEN3,"EN")
  1.  S DENFLG=$S(BGPDEN2'="":2,BGPDEN3'="":3,1:0)
  1.  S BGPDEN1=$S(DENFLG=2:BGPDEN2,DENFLG=3:BGPDEN3,1:"")
  1.  ;
  1.  ;check if patient is in the numerator
  1.  ;  check lab for chlamydia screening
  1.  ;check lab for chlamydia screening test
  1.  K LABDATA
  1.  D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC CHLAMYDIA","BGPMU LAB CPT CHLAMYDIA",0,BGPEDATE)
  1.  I +LABDATA S BGPNUM="M:CHL "_$$DATE^BGPMUUTL($P($P(LABDATA,U,2),".",1))
  1.  ;I BGPNUM1'="" X "S BGPNUM"_DENFLG_"=BGPNUM1"
  1.  I BGPNUM="" S BGPNOT="NM:"
  1.  ;
  1.  ;check for exclusions
  1.  S X=0
  1.  I BGPNUM="" S X=$$EXCLUDE(DFN)
  1.  I +X S BGPEXC="Excluded" S (BGPNUM,BGPNOT)=""
  1.  ;
  1.  D TOTAL(DFN)
  1.  Q
  1.  ;
  1. TOTAL(DFN) ;See where this patient ends up
  1.  N PTCNT,EXCCT,DENCT1,DENCT2,DENCT3,NUMCT,NOTNUM,TOTALS
  1.  S TOTALS=$G(^TMP("BGPMU0033",$J,BGPMUTF,"TOT"))
  1.  S DENCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",1))
  1.  S DENCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",2))
  1.  S DENCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",3))
  1.  S NUMCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",1))
  1.  S NUMCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",2))
  1.  S NUMCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",3))
  1.  S EXCCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",1))
  1.  S EXCCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",2))
  1.  S EXCCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",3))
  1.  S NOTNUM1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",1))
  1.  S NOTNUM2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",2))
  1.  S NOTNUM3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",3))
  1.  S PTCNT=TOTALS
  1.  S PTCNT=PTCNT+1
  1.  S DENCT1=DENCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",1)=DENCT1
  1.  I BGPDEN2'="" S DENCT2=DENCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",2)=DENCT2
  1.  I BGPDEN3'="" S DENCT3=DENCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",3)=DENCT3
  1.  ;
  1.  I BGPNOT'="" D
  1.  .S NOTNUM1=NOTNUM1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",1)=NOTNUM1
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNOT
  1.  .I DENFLG=2 D
  1.  ..S NOTNUM2=NOTNUM2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",2)=NOTNUM2
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNOT
  1.  .I DENFLG=3 D
  1.  ..S NOTNUM3=NOTNUM3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",3)=NOTNUM3
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNOT
  1.  ;
  1.  I BGPNUM'="" D
  1.  .S NUMCT1=NUMCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",1)=NUMCT1
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNUM
  1.  .I DENFLG=2 D
  1.  ..S NUMCT2=NUMCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",2)=NUMCT2
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNUM
  1.  .I DENFLG=3 D
  1.  ..S NUMCT3=NUMCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",3)=NUMCT3
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNUM
  1.  ;
  1.  I BGPEXC'="" D
  1.  .S EXCCT1=EXCCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",1)=EXCCT1
  1.  .I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",1,PTCNT)=DFN_U_BGPDEN1_U_BGPEXC
  1.  .I DENFLG=2 D
  1.  ..S EXCCT2=EXCCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",2)=EXCCT2
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",2,PTCNT)=DFN_U_BGPDEN2_U_BGPEXC
  1.  .I DENFLG=3 D
  1.  ..S EXCCT3=EXCCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",3)=EXCCT3
  1.  ..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",3,PTCNT)=DFN_U_BGPDEN3_U_BGPEXC
  1.  S ^TMP("BGPMU0033",$J,BGPMUTF,"TOT")=PTCNT
  1.  ;Setup iCare array for patient
  1.  ; BGPICARE(INDICATOR_ID,Timeframe)=Denom Flag
  1.  ;                                    ^ Num Flag     ^ Excl Flag    ^ Denom disp ; Num disp ^ Excl disp
  1.  S BGPICARE("MU.EP.0033.1",BGPMUTF)=1_U_(BGPNUM'="")_U_(BGPEXC'="")_U_BGPDEN1_";"_$S(BGPNUM'="":BGPNUM,1:"")_U_$S(BGPEXC="":BGPEXC,1:"")
  1.  Q
  1.  ;
  1. DENPOP(DFN,BGPAGEE,X,BGPDEN2,BGPDEN3,TXT) ;create population text for pt
  1.  S:(BGPAGEE>14)&(BGPAGEE<20) BGPDEN2=$S(BGPDEN2'="":BGPDEN2_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
  1.  S:(BGPAGEE>19)&(BGPAGEE<25) BGPDEN3=$S(BGPDEN3'="":BGPDEN3_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
  1.  Q
  1.  ;
  1. EXCLUDE(DFN) ;check exclusions
  1.  ;check lab for chlamydia screening test
  1.  K EXAM,LABDATA,LABDT,RAMIS,TIEN
  1.  S (EXAM,LABDATA,LABDT,LABX,RAMIS)=0
  1.  D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
  1.  I +LABDATA D
  1.  .S LABDT=$S($P(LABDATA,U,5)'="":$P($P(LABDATA,U,5),".",1),$P(LABDATA,U,2)'="":$P($P(LABDATA,U,2),".",1),1:0)
  1.  .Q:LABDT=0
  1.  .S LABX=$$FIND^BGPMUUT8(DFN,"BGPMU RETINOID NDCS",LABDT,"",$$FMADD^XLFDT(LABDT,7),"")
  1.  .I '+LABX D
  1.  ..S TIEN="" S TIEN=$O(^ATXAX("B","BGPMU X-RAY STUDY CPT",0))
  1.  ..S RIEN=$O(^RADPT("B",DFN,""))
  1.  ..Q:RIEN=""
  1.  ..S RE="" F  S RE=$O(^RADPT(RIEN,"DT",RE)) Q:RE=""  D
  1.  ...S EXAM=0 F  S EXAM=$O(^RADPT(RIEN,"DT",RE,"P",EXAM)) Q:EXAM=""  D
  1.  ....S RAMIS=$P($G(^RADPT(RIEN,"DT",RE,"P",EXAM,0)),U,2)
  1.  ....Q:RAMIS=""
  1.  ....S CPT=$P($G(^RAMIS(71,RAMIS,0)),U,9)
  1.  ....Q:CPT=""
  1.  ....I $D(^ATXAX(TIEN,21,"B",CPT)) S LABX=1
  1.  .I '+LABX D
  1.  ..S LABX=$$RAD^BGPMUUT1(DFN,0,BGPEDATE,"BGPMU X-RAY STUDY CPT",1)
  1.  Q +LABX
  1.  ;
  1. TEST ; debug target
  1.  S U="^"
  1.  S DT=$$DT^XLFDT()
  1.  S DFN=469             ;  DFN      = patient code from VA PATIENT file
  1.  S BGPBDATE=3100101   ;  BGPBDATE = begin date of report
  1.  S BGPEDATE=3101231   ;  BGPEDATE = end date of report
  1.  S BGPPROV=2          ;  BGPPROV   = provider code from NEW PERSON file
  1.  S BGPMUTF="C"        ;  BGPMUTF  = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
  1.  D ENTRY
  1.  Q