BGPMUD08 ; IHS/MSC/SAT - MI measure NQF0033 ;25-AUG-2011 14:56
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;
; BGPMUD01 = tobacco use assessment 0028a
; BGPMUD02 = tobacco use cessation 0028b
; BGPMUD03 = Heart Failure w/ACE Inhibitor or ARB 0081
; BGPMUD04 = Prenatal HIV Screening 0012
; BGPMUD05 = Prenatal Anti-D Immune Globulin 0014
; BGPMUD06 = Control High Blood Pressure 0018
; BGPMUD07 = SMOKING CESSATION MEDICAL ASSIST 0027
; BGPMUD08 = Chlamydia Measure 0033
; BGPMUD09 = Antidepressant Medication Management 0105
; BGPMUD10 = Oncology Colon Cancer Stage III 0385
;
;Code to collect meaningful use report for Chlamydia Measure 0033
ENTRY ;EP
N START,END,BGPNUM,STRING,STRING2
N IEN,INV,RFOUND,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN
N CNT,DIAB,NUM,DIAB,DIABDX,OUTENC,OPHENC,NONENC,VENC,INENC,ERENC
N BGPALL,BGPAR,BGPEXC,BGPH
; BGPDEN1 = ages 15-24
; BGPDEN2 = ages 15-19
; BGPDEN3 = ages 20-24
S (BGPDEN1,BGPDEN2,BGPDEN3,BGPEXC,BGPNUM,BGPNOT)=""
S BGPALL=""
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START=START_".2359"
;only check female
S BGPSEX=$$SEX^AUPNPAT(DFN)
Q:BGPSEX'="F"
;Pts must be >=15 and <=24
S BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
S BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
;No need to check further if no age match
Q:BGPAGEE<15!(BGPAGEB>24) ;determine if the patient was between 15 & 24 yrs during the reporting period
S X=0
;look for 1 outpatient encounter with the EP back to 365 days prior to the end of the reporting period
S START=9999999-$$FMADD^XLFDT(BGPEDATE,-365),END=9999999-BGPEDATE
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START) D Q:+X
.S VIEN=0 F S VIEN=$O(^AUPNVSIT("AA",DFN,FIRST,VIEN)) Q:'+VIEN D Q:+X
..S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
..;Check provider, determine if there are visits with E&M codes
..I $$PRV^BGPMUUT1(VIEN,BGPPROV) D
...S X=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENCOUNTER OUTPT")
...I '+X S X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ENC OUTPATIENT ICD")
;
Q:'+X ;quit if no encounter found
;check if sexually active
S X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM CPT")
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
S X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM ICD0")
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
;check for pregnancy
K LABDATA
D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
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")
;check for pregnancy encounter
S X=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU PREGNANCY ENC ICD")
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PREG")
;check lab indicative of sexually active (anytime prior to the report period end date)
K LABDATA
D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC SEX ACTIVE FEM","BGPMU LAB CPT SEX ACTIVE FEM",0,BGPEDATE)
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")
;check VPOV for DX indicative of sexually active (anytime prior to the report period end date)
S X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM DX")
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"DX")
;check PRESCRIPTION for contraceptives
S X=$$FIND^BGPMUUT8(DFN,"BGPMU CONTRACEPTIVES NDCS",BGPBDATE,"",BGPEDATE,"")
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"MED")
;check IUD device use
S X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU IUD ENC ICD")
S:'+X X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD ICD0")
S:'+X X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD CPT")
I '+X D
.S BGPIEN=$O(^AUPNREP("B",DFN,""))
.S BGPRF=$$GET1^DIQ(9000017,BGPIEN_",",3)
.S:BGPRF="IUD" X=1_U_U_$P(^AUPNREP(BGPIEN,0),U,7)
I +X S X=$P(X,U,3) D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"IUD")
;check PATIENT ALLERGIES for allergy to IUD
S BGPH="" F S BGPH=$O(^GMR(120.8,"B",DFN,BGPH)) Q:BGPH="" D Q:(BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD")
.S BGPALL=$P(^GMR(120.8,BGPH,0),U,2)
.I (BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD") D
..S X=$P($P(^GMR(120.8,BGPH,0),U,4),".",1)
..D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"ALR")
;
;check V PATIENT EDUCATION
S TIEN="" S TIEN=$O(^ATXAX("B","BGPMU CONTRACEPTIVE EDU",0))
S EIEN="" F S EIEN=$O(^AUPNVPED("AC",DFN,EIEN)) Q:EIEN="" D
.S ETOPIC=$P($G(^AUPNVPED(EIEN,0)),U,1)
.Q:'ETOPIC
.Q:'$D(^AUTTEDT(ETOPIC,0))
.S BGPNMEM=$P($G(^AUTTEDT(ETOPIC,0)),U,2) ;get mnemonic
.I BGPNMEM'="" D
..I $D(^ATXAX(TIEN,21,"B",BGPNMEM)) D
...S EDATE=$P($G(^AUPNVPED(EIEN,12)),U,1)
...I EDATE="" S EDATE=BGPDT
...S BGPAR(EDATE)=$P(EDATE,".",1)
I +$D(BGPAR) D
.S X=$O(BGPAR(0))
.S X=BGPAR(X)
.D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"EDU")
;
;check REPRODUCTIVE FACTORS
S RFOUND=0
S EIEN=$O(^AUPNREP("B",DFN,""))
I EIEN'="" D
.S BGPREC0=^AUPNREP(EIEN,0)
.S BGPREC11=$G(^AUPNREP(EIEN,11))
.S:($P(BGPREC0,U,6)'="")&($P($P(BGPREC0,U,7),".",1)<(BGPEDATE+1)) RFOUND=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)
.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
.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
.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
.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
.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
.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
.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
.I +RFOUND D
..S X=$P(RFOUND,U,2)
..D DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"RF")
;
Q:(BGPDEN2="")&(BGPDEN3="")
D:BGPDEN2'="" DENPOP(DFN,BGPAGEE,BGPDT,.BGPDEN2,"","EN")
D:BGPDEN3'="" DENPOP(DFN,BGPAGEE,BGPDT,"",.BGPDEN3,"EN")
S DENFLG=$S(BGPDEN2'="":2,BGPDEN3'="":3,1:0)
S BGPDEN1=$S(DENFLG=2:BGPDEN2,DENFLG=3:BGPDEN3,1:"")
;
;check if patient is in the numerator
; check lab for chlamydia screening
;check lab for chlamydia screening test
K LABDATA
D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC CHLAMYDIA","BGPMU LAB CPT CHLAMYDIA",0,BGPEDATE)
I +LABDATA S BGPNUM="M:CHL "_$$DATE^BGPMUUTL($P($P(LABDATA,U,2),".",1))
;I BGPNUM1'="" X "S BGPNUM"_DENFLG_"=BGPNUM1"
I BGPNUM="" S BGPNOT="NM:"
;
;check for exclusions
S X=0
I BGPNUM="" S X=$$EXCLUDE(DFN)
I +X S BGPEXC="Excluded" S (BGPNUM,BGPNOT)=""
;
D TOTAL(DFN)
Q
;
TOTAL(DFN) ;See where this patient ends up
N PTCNT,EXCCT,DENCT1,DENCT2,DENCT3,NUMCT,NOTNUM,TOTALS
S TOTALS=$G(^TMP("BGPMU0033",$J,BGPMUTF,"TOT"))
S DENCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",1))
S DENCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",2))
S DENCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"DEN",3))
S NUMCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",1))
S NUMCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",2))
S NUMCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NUM",3))
S EXCCT1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",1))
S EXCCT2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",2))
S EXCCT3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"EXC",3))
S NOTNUM1=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",1))
S NOTNUM2=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",2))
S NOTNUM3=+$G(^TMP("BGPMU0033",$J,BGPMUTF,"NOT",3))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
S DENCT1=DENCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",1)=DENCT1
I BGPDEN2'="" S DENCT2=DENCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",2)=DENCT2
I BGPDEN3'="" S DENCT3=DENCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"DEN",3)=DENCT3
;
I BGPNOT'="" D
.S NOTNUM1=NOTNUM1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",1)=NOTNUM1
.I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNOT
.I DENFLG=2 D
..S NOTNUM2=NOTNUM2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",2)=NOTNUM2
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNOT
.I DENFLG=3 D
..S NOTNUM3=NOTNUM3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NOT",3)=NOTNUM3
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NOT",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNOT
;
I BGPNUM'="" D
.S NUMCT1=NUMCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",1)=NUMCT1
.I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNUM
.I DENFLG=2 D
..S NUMCT2=NUMCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",2)=NUMCT2
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNUM
.I DENFLG=3 D
..S NUMCT3=NUMCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"NUM",3)=NUMCT3
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"NUM",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNUM
;
I BGPEXC'="" D
.S EXCCT1=EXCCT1+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",1)=EXCCT1
.I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",1,PTCNT)=DFN_U_BGPDEN1_U_BGPEXC
.I DENFLG=2 D
..S EXCCT2=EXCCT2+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",2)=EXCCT2
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",2,PTCNT)=DFN_U_BGPDEN2_U_BGPEXC
.I DENFLG=3 D
..S EXCCT3=EXCCT3+1 S ^TMP("BGPMU0033",$J,BGPMUTF,"EXC",3)=EXCCT3
..I BGPMUTF="C" S ^TMP("BGPMU0033",$J,"PAT",BGPMUTF,"EXC",3,PTCNT)=DFN_U_BGPDEN3_U_BGPEXC
S ^TMP("BGPMU0033",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
; BGPICARE(INDICATOR_ID,Timeframe)=Denom Flag
; ^ Num Flag ^ Excl Flag ^ Denom disp ; Num disp ^ Excl disp
S BGPICARE("MU.EP.0033.1",BGPMUTF)=1_U_(BGPNUM'="")_U_(BGPEXC'="")_U_BGPDEN1_";"_$S(BGPNUM'="":BGPNUM,1:"")_U_$S(BGPEXC="":BGPEXC,1:"")
Q
;
DENPOP(DFN,BGPAGEE,X,BGPDEN2,BGPDEN3,TXT) ;create population text for pt
S:(BGPAGEE>14)&(BGPAGEE<20) BGPDEN2=$S(BGPDEN2'="":BGPDEN2_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
S:(BGPAGEE>19)&(BGPAGEE<25) BGPDEN3=$S(BGPDEN3'="":BGPDEN3_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
Q
;
EXCLUDE(DFN) ;check exclusions
;check lab for chlamydia screening test
K EXAM,LABDATA,LABDT,RAMIS,TIEN
S (EXAM,LABDATA,LABDT,LABX,RAMIS)=0
D LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
I +LABDATA D
.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)
.Q:LABDT=0
.S LABX=$$FIND^BGPMUUT8(DFN,"BGPMU RETINOID NDCS",LABDT,"",$$FMADD^XLFDT(LABDT,7),"")
.I '+LABX D
..S TIEN="" S TIEN=$O(^ATXAX("B","BGPMU X-RAY STUDY CPT",0))
..S RIEN=$O(^RADPT("B",DFN,""))
..Q:RIEN=""
..S RE="" F S RE=$O(^RADPT(RIEN,"DT",RE)) Q:RE="" D
...S EXAM=0 F S EXAM=$O(^RADPT(RIEN,"DT",RE,"P",EXAM)) Q:EXAM="" D
....S RAMIS=$P($G(^RADPT(RIEN,"DT",RE,"P",EXAM,0)),U,2)
....Q:RAMIS=""
....S CPT=$P($G(^RAMIS(71,RAMIS,0)),U,9)
....Q:CPT=""
....I $D(^ATXAX(TIEN,21,"B",CPT)) S LABX=1
.I '+LABX D
..S LABX=$$RAD^BGPMUUT1(DFN,0,BGPEDATE,"BGPMU X-RAY STUDY CPT",1)
Q +LABX
;
TEST ; debug target
S U="^"
S DT=$$DT^XLFDT()
S DFN=469 ; DFN = patient code from VA PATIENT file
S BGPBDATE=3100101 ; BGPBDATE = begin date of report
S BGPEDATE=3101231 ; BGPEDATE = end date of report
S BGPPROV=2 ; BGPPROV = provider code from NEW PERSON file
S BGPMUTF="C" ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
D ENTRY
Q
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
+2 ;
+3 ; BGPMUD01 = tobacco use assessment 0028a
+4 ; BGPMUD02 = tobacco use cessation 0028b
+5 ; BGPMUD03 = Heart Failure w/ACE Inhibitor or ARB 0081
+6 ; BGPMUD04 = Prenatal HIV Screening 0012
+7 ; BGPMUD05 = Prenatal Anti-D Immune Globulin 0014
+8 ; BGPMUD06 = Control High Blood Pressure 0018
+9 ; BGPMUD07 = SMOKING CESSATION MEDICAL ASSIST 0027
+10 ; BGPMUD08 = Chlamydia Measure 0033
+11 ; BGPMUD09 = Antidepressant Medication Management 0105
+12 ; BGPMUD10 = Oncology Colon Cancer Stage III 0385
+13 ;
+14 ;Code to collect meaningful use report for Chlamydia Measure 0033
ENTRY ;EP
+1 NEW START,END,BGPNUM,STRING,STRING2
+2 NEW IEN,INV,RFOUND,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN
+3 NEW CNT,DIAB,NUM,DIAB,DIABDX,OUTENC,OPHENC,NONENC,VENC,INENC,ERENC
+4 NEW BGPALL,BGPAR,BGPEXC,BGPH
+5 ; BGPDEN1 = ages 15-24
+6 ; BGPDEN2 = ages 15-19
+7 ; BGPDEN3 = ages 20-24
+8 SET (BGPDEN1,BGPDEN2,BGPDEN3,BGPEXC,BGPNUM,BGPNOT)=""
+9 SET BGPALL=""
+10 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+11 SET START=START_".2359"
+12 ;only check female
+13 SET BGPSEX=$$SEX^AUPNPAT(DFN)
+14 IF BGPSEX'="F"
QUIT
+15 ;Pts must be >=15 and <=24
+16 SET BGPAGEB=$$AGE^AUPNPAT(DFN,BGPBDATE)
+17 SET BGPAGEE=$$AGE^AUPNPAT(DFN,BGPEDATE)
+18 ;No need to check further if no age match
+19 ;determine if the patient was between 15 & 24 yrs during the reporting period
IF BGPAGEE<15!(BGPAGEB>24)
QUIT
+20 SET X=0
+21 ;look for 1 outpatient encounter with the EP back to 365 days prior to the end of the reporting period
+22 SET START=9999999-$$FMADD^XLFDT(BGPEDATE,-365)
SET END=9999999-BGPEDATE
+23 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)
QUIT
Begin DoDot:1
+24 SET VIEN=0
FOR
SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,VIEN))
IF '+VIEN
QUIT
Begin DoDot:2
+25 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+26 ;Check provider, determine if there are visits with E&M codes
+27 IF $$PRV^BGPMUUT1(VIEN,BGPPROV)
Begin DoDot:3
+28 SET X=$$VSTCPT^BGPMUUT1(DFN,VIEN,"BGPMU ENCOUNTER OUTPT")
+29 IF '+X
SET X=$$VSTPOV^BGPMUUT3(DFN,VIEN,"BGPMU ENC OUTPATIENT ICD")
End DoDot:3
End DoDot:2
IF +X
QUIT
End DoDot:1
IF +X
QUIT
+30 ;
+31 ;quit if no encounter found
IF '+X
QUIT
+32 ;check if sexually active
+33 SET X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM CPT")
+34 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
+35 SET X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM ICD0")
+36 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PROC")
+37 ;check for pregnancy
+38 KILL LABDATA
+39 DO LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
+40 IF +LABDATA
SET X=$SELECT($PIECE(LABDATA,U,5)'="":$PIECE($PIECE(LABDATA,U,5),".",1),$PIECE(LABDATA,U,2)'="":$PIECE($PIECE(LABDATA,U,2),".",1),1:BGPDT)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"LABP")
+41 ;check for pregnancy encounter
+42 SET X=$$LASTDX^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU PREGNANCY ENC ICD")
+43 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"PREG")
+44 ;check lab indicative of sexually active (anytime prior to the report period end date)
+45 KILL LABDATA
+46 DO LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC SEX ACTIVE FEM","BGPMU LAB CPT SEX ACTIVE FEM",0,BGPEDATE)
+47 IF +LABDATA
SET X=$SELECT($PIECE(LABDATA,U,5)'="":$PIECE($PIECE(LABDATA,U,5),".",1),$PIECE(LABDATA,U,2)'="":$PIECE($PIECE(LABDATA,U,2),".",1),1:BGPDT)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"LAB")
+48 ;check VPOV for DX indicative of sexually active (anytime prior to the report period end date)
+49 SET X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU SEXUALLY ACTIVE FEM DX")
+50 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"DX")
+51 ;check PRESCRIPTION for contraceptives
+52 SET X=$$FIND^BGPMUUT8(DFN,"BGPMU CONTRACEPTIVES NDCS",BGPBDATE,"",BGPEDATE,"")
+53 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"MED")
+54 ;check IUD device use
+55 SET X=$$LASTDX^BGPMUUT2(DFN,0,BGPEDATE,"BGPMU IUD ENC ICD")
+56 IF '+X
SET X=$$LASTPRC^BGPMUUT2(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD ICD0")
+57 IF '+X
SET X=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU IUD CPT")
+58 IF '+X
Begin DoDot:1
+59 SET BGPIEN=$ORDER(^AUPNREP("B",DFN,""))
+60 SET BGPRF=$$GET1^DIQ(9000017,BGPIEN_",",3)
+61 IF BGPRF="IUD"
SET X=1_U_U_$PIECE(^AUPNREP(BGPIEN,0),U,7)
End DoDot:1
+62 IF +X
SET X=$PIECE(X,U,3)
DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"IUD")
+63 ;check PATIENT ALLERGIES for allergy to IUD
+64 SET BGPH=""
FOR
SET BGPH=$ORDER(^GMR(120.8,"B",DFN,BGPH))
IF BGPH=""
QUIT
Begin DoDot:1
+65 SET BGPALL=$PIECE(^GMR(120.8,BGPH,0),U,2)
+66 IF (BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD")
Begin DoDot:2
+67 SET X=$PIECE($PIECE(^GMR(120.8,BGPH,0),U,4),".",1)
+68 DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"ALR")
End DoDot:2
End DoDot:1
IF (BGPALL="LEVONORGESTREL")!(BGPALL="COPPER IUD")!(BGPALL="PARAGARD IUD")
QUIT
+69 ;
+70 ;check V PATIENT EDUCATION
+71 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B","BGPMU CONTRACEPTIVE EDU",0))
+72 SET EIEN=""
FOR
SET EIEN=$ORDER(^AUPNVPED("AC",DFN,EIEN))
IF EIEN=""
QUIT
Begin DoDot:1
+73 SET ETOPIC=$PIECE($GET(^AUPNVPED(EIEN,0)),U,1)
+74 IF 'ETOPIC
QUIT
+75 IF '$DATA(^AUTTEDT(ETOPIC,0))
QUIT
+76 ;get mnemonic
SET BGPNMEM=$PIECE($GET(^AUTTEDT(ETOPIC,0)),U,2)
+77 IF BGPNMEM'=""
Begin DoDot:2
+78 IF $DATA(^ATXAX(TIEN,21,"B",BGPNMEM))
Begin DoDot:3
+79 SET EDATE=$PIECE($GET(^AUPNVPED(EIEN,12)),U,1)
+80 IF EDATE=""
SET EDATE=BGPDT
+81 SET BGPAR(EDATE)=$PIECE(EDATE,".",1)
End DoDot:3
End DoDot:2
End DoDot:1
+82 IF +$DATA(BGPAR)
Begin DoDot:1
+83 SET X=$ORDER(BGPAR(0))
+84 SET X=BGPAR(X)
+85 DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"EDU")
End DoDot:1
+86 ;
+87 ;check REPRODUCTIVE FACTORS
+88 SET RFOUND=0
+89 SET EIEN=$ORDER(^AUPNREP("B",DFN,""))
+90 IF EIEN'=""
Begin DoDot:1
+91 SET BGPREC0=^AUPNREP(EIEN,0)
+92 SET BGPREC11=$GET(^AUPNREP(EIEN,11))
+93 IF ($PIECE(BGPREC0,U,6)'="")&($PIECE($PIECE(BGPREC0,U,7),".",1)<(BGPEDATE+1))
SET RFOUND=1
+94 ;gravida (# of pregnancies)
IF '+RFOUND
IF ($PIECE(BGPREC11,U,3)&($PIECE($PIECE(BGPREC11,U,4),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,4),".",1)
+95 ;multiple births
IF '+RFOUND
IF ($PIECE(BGPREC11,U,5)&($PIECE($PIECE(BGPREC11,U,6),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,6),".",1)
+96 ;full term births
IF '+RFOUND
IF ($PIECE(BGPREC11,U,7)&($PIECE($PIECE(BGPREC11,U,8),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,8),".",1)
+97 ;premature births
IF '+RFOUND
IF ($PIECE(BGPREC11,U,9)&($PIECE($PIECE(BGPREC11,U,10),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,10),".",1)
+98 ;ectopic pregnancies
IF '+RFOUND
IF ($PIECE(BGPREC11,U,11)&($PIECE($PIECE(BGPREC11,U,12),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,12),".",1)
+99 ;living children
IF '+RFOUND
IF ($PIECE(BGPREC11,U,13)&($PIECE($PIECE(BGPREC11,U,14),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,14),".",1)
+100 ;therapeutic abortions
IF '+RFOUND
IF ($PIECE(BGPREC11,U,31)&($PIECE($PIECE(BGPREC11,U,32),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,32),".",1)
+101 ;spontaneous abortions
IF '+RFOUND
IF ($PIECE(BGPREC11,U,33)&($PIECE($PIECE(BGPREC11,U,34),".",1)<(BGPEDATE+1)))
SET RFOUND=1_U_$PIECE($PIECE(BGPREC11,U,34),".",1)
+102 IF +RFOUND
Begin DoDot:2
+103 SET X=$PIECE(RFOUND,U,2)
+104 DO DENPOP(DFN,BGPAGEE,X,.BGPDEN2,.BGPDEN3,"RF")
End DoDot:2
End DoDot:1
+105 ;
+106 IF (BGPDEN2="")&(BGPDEN3="")
QUIT
+107 IF BGPDEN2'=""
DO DENPOP(DFN,BGPAGEE,BGPDT,.BGPDEN2,"","EN")
+108 IF BGPDEN3'=""
DO DENPOP(DFN,BGPAGEE,BGPDT,"",.BGPDEN3,"EN")
+109 SET DENFLG=$SELECT(BGPDEN2'="":2,BGPDEN3'="":3,1:0)
+110 SET BGPDEN1=$SELECT(DENFLG=2:BGPDEN2,DENFLG=3:BGPDEN3,1:"")
+111 ;
+112 ;check if patient is in the numerator
+113 ; check lab for chlamydia screening
+114 ;check lab for chlamydia screening test
+115 KILL LABDATA
+116 DO LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC CHLAMYDIA","BGPMU LAB CPT CHLAMYDIA",0,BGPEDATE)
+117 IF +LABDATA
SET BGPNUM="M:CHL "_$$DATE^BGPMUUTL($PIECE($PIECE(LABDATA,U,2),".",1))
+118 ;I BGPNUM1'="" X "S BGPNUM"_DENFLG_"=BGPNUM1"
+119 IF BGPNUM=""
SET BGPNOT="NM:"
+120 ;
+121 ;check for exclusions
+122 SET X=0
+123 IF BGPNUM=""
SET X=$$EXCLUDE(DFN)
+124 IF +X
SET BGPEXC="Excluded"
SET (BGPNUM,BGPNOT)=""
+125 ;
+126 DO TOTAL(DFN)
+127 QUIT
+128 ;
TOTAL(DFN) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT1,DENCT2,DENCT3,NUMCT,NOTNUM,TOTALS
+2 SET TOTALS=$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT1=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",1))
+4 SET DENCT2=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",2))
+5 SET DENCT3=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",3))
+6 SET NUMCT1=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",1))
+7 SET NUMCT2=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",2))
+8 SET NUMCT3=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",3))
+9 SET EXCCT1=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",1))
+10 SET EXCCT2=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",2))
+11 SET EXCCT3=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",3))
+12 SET NOTNUM1=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",1))
+13 SET NOTNUM2=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",2))
+14 SET NOTNUM3=+$GET(^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",3))
+15 SET PTCNT=TOTALS
+16 SET PTCNT=PTCNT+1
+17 SET DENCT1=DENCT1+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",1)=DENCT1
+18 IF BGPDEN2'=""
SET DENCT2=DENCT2+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",2)=DENCT2
+19 IF BGPDEN3'=""
SET DENCT3=DENCT3+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"DEN",3)=DENCT3
+20 ;
+21 IF BGPNOT'=""
Begin DoDot:1
+22 SET NOTNUM1=NOTNUM1+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",1)=NOTNUM1
+23 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NOT",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNOT
+24 IF DENFLG=2
Begin DoDot:2
+25 SET NOTNUM2=NOTNUM2+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",2)=NOTNUM2
+26 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NOT",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNOT
End DoDot:2
+27 IF DENFLG=3
Begin DoDot:2
+28 SET NOTNUM3=NOTNUM3+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NOT",3)=NOTNUM3
+29 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NOT",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNOT
End DoDot:2
End DoDot:1
+30 ;
+31 IF BGPNUM'=""
Begin DoDot:1
+32 SET NUMCT1=NUMCT1+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",1)=NUMCT1
+33 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NUM",1,PTCNT)=DFN_U_BGPDEN1_U_BGPNUM
+34 IF DENFLG=2
Begin DoDot:2
+35 SET NUMCT2=NUMCT2+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",2)=NUMCT2
+36 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NUM",2,PTCNT)=DFN_U_BGPDEN2_U_BGPNUM
End DoDot:2
+37 IF DENFLG=3
Begin DoDot:2
+38 SET NUMCT3=NUMCT3+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"NUM",3)=NUMCT3
+39 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"NUM",3,PTCNT)=DFN_U_BGPDEN3_U_BGPNUM
End DoDot:2
End DoDot:1
+40 ;
+41 IF BGPEXC'=""
Begin DoDot:1
+42 SET EXCCT1=EXCCT1+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",1)=EXCCT1
+43 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"EXC",1,PTCNT)=DFN_U_BGPDEN1_U_BGPEXC
+44 IF DENFLG=2
Begin DoDot:2
+45 SET EXCCT2=EXCCT2+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",2)=EXCCT2
+46 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"EXC",2,PTCNT)=DFN_U_BGPDEN2_U_BGPEXC
End DoDot:2
+47 IF DENFLG=3
Begin DoDot:2
+48 SET EXCCT3=EXCCT3+1
SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"EXC",3)=EXCCT3
+49 IF BGPMUTF="C"
SET ^TMP("BGPMU0033",$JOB,"PAT",BGPMUTF,"EXC",3,PTCNT)=DFN_U_BGPDEN3_U_BGPEXC
End DoDot:2
End DoDot:1
+50 SET ^TMP("BGPMU0033",$JOB,BGPMUTF,"TOT")=PTCNT
+51 ;Setup iCare array for patient
+52 ; BGPICARE(INDICATOR_ID,Timeframe)=Denom Flag
+53 ; ^ Num Flag ^ Excl Flag ^ Denom disp ; Num disp ^ Excl disp
+54 SET BGPICARE("MU.EP.0033.1",BGPMUTF)=1_U_(BGPNUM'="")_U_(BGPEXC'="")_U_BGPDEN1_";"_$SELECT(BGPNUM'="":BGPNUM,1:"")_U_$SELECT(BGPEXC="":BGPEXC,1:"")
+55 QUIT
+56 ;
DENPOP(DFN,BGPAGEE,X,BGPDEN2,BGPDEN3,TXT) ;create population text for pt
+1 IF (BGPAGEE>14)&(BGPAGEE<20)
SET BGPDEN2=$SELECT(BGPDEN2'="":BGPDEN2_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
+2 IF (BGPAGEE>19)&(BGPAGEE<25)
SET BGPDEN3=$SELECT(BGPDEN3'="":BGPDEN3_";",1:"")_TXT_":"_$$DATE^BGPMUUTL(X)
+3 QUIT
+4 ;
EXCLUDE(DFN) ;check exclusions
+1 ;check lab for chlamydia screening test
+2 KILL EXAM,LABDATA,LABDT,RAMIS,TIEN
+3 SET (EXAM,LABDATA,LABDT,LABX,RAMIS)=0
+4 DO LAB^BGPMUD04(.LABDATA,DFN,"BGPMU LAB LOINC PREGNANCY","BGPMU LAB CPT PREGNANCY",BGPBDATE,BGPEDATE)
+5 IF +LABDATA
Begin DoDot:1
+6 SET LABDT=$SELECT($PIECE(LABDATA,U,5)'="":$PIECE($PIECE(LABDATA,U,5),".",1),$PIECE(LABDATA,U,2)'="":$PIECE($PIECE(LABDATA,U,2),".",1),1:0)
+7 IF LABDT=0
QUIT
+8 SET LABX=$$FIND^BGPMUUT8(DFN,"BGPMU RETINOID NDCS",LABDT,"",$$FMADD^XLFDT(LABDT,7),"")
+9 IF '+LABX
Begin DoDot:2
+10 SET TIEN=""
SET TIEN=$ORDER(^ATXAX("B","BGPMU X-RAY STUDY CPT",0))
+11 SET RIEN=$ORDER(^RADPT("B",DFN,""))
+12 IF RIEN=""
QUIT
+13 SET RE=""
FOR
SET RE=$ORDER(^RADPT(RIEN,"DT",RE))
IF RE=""
QUIT
Begin DoDot:3
+14 SET EXAM=0
FOR
SET EXAM=$ORDER(^RADPT(RIEN,"DT",RE,"P",EXAM))
IF EXAM=""
QUIT
Begin DoDot:4
+15 SET RAMIS=$PIECE($GET(^RADPT(RIEN,"DT",RE,"P",EXAM,0)),U,2)
+16 IF RAMIS=""
QUIT
+17 SET CPT=$PIECE($GET(^RAMIS(71,RAMIS,0)),U,9)
+18 IF CPT=""
QUIT
+19 IF $DATA(^ATXAX(TIEN,21,"B",CPT))
SET LABX=1
End DoDot:4
End DoDot:3
End DoDot:2
+20 IF '+LABX
Begin DoDot:2
+21 SET LABX=$$RAD^BGPMUUT1(DFN,0,BGPEDATE,"BGPMU X-RAY STUDY CPT",1)
End DoDot:2
End DoDot:1
+22 QUIT +LABX
+23 ;
TEST ; debug target
+1 SET U="^"
+2 SET DT=$$DT^XLFDT()
+3 ; DFN = patient code from VA PATIENT file
SET DFN=469
+4 ; BGPBDATE = begin date of report
SET BGPBDATE=3100101
+5 ; BGPEDATE = end date of report
SET BGPEDATE=3101231
+6 ; BGPPROV = provider code from NEW PERSON file
SET BGPPROV=2
+7 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
SET BGPMUTF="C"
+8 DO ENTRY
+9 QUIT
