BGPMUA04 ; IHS/MSC/MGH - MI measure NQF0032 ;01-Mar-2011 15:37;MGH
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;Code to collect meaningful use report for cervical cancer screening
ENTRY ;EP
N START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC
N IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT
N BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMUMAM,BGPMAS,AENC,BENC,CENC
N BGPENC,BGPPAP,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4,BGPPAP1,BGPPAP2,BGPPAP3,BGPPAP4,BGPDSTR,BGPNSTR
N BGPPAP2,STRING1,STRING2
S (BGPDEN,BGPNUM,RESULT)=0
S (STRING1,STRING2,BGPDSTR,BGPNSTR)=""
;Set a new begin date of 2 years prior reporting period end date
N X1,X2,X S X1=BGPEDATE,X2=-730 D C^%DTC S BGPENC=X
S START=9999999-BGPENC,END=9999999-BGPEDATE,VALUE=0
S (RETVAL,VIEN)="" ;Return value
Q:BGPSEX="M" ;Patients must be female
;Pts must be 23-63
;No need to check further if no age match
Q:(BGPAGEB<23)!(BGPAGEB>63)
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)!(VIEN]"") D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN!(VIEN]"") D
..;Check provider, Only visits for chosen provider
..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)
..;Quit if any visit in the last 2 years does not have a valid E&M code
..S AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU MAMMOGRAM ENC EM")
..S BENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU MAMMOGRAM ENC ICD")
..S CENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU OBGYN ENC DX")
..Q:(AENC=0)&(BENC=0)&(CENC=0)
..I AENC S STRING1="ENC:"_$P(AENC,U,2)
..I BENC S STRING1="ENC:"_$P(BENC,U,2)
..I CENC S STRING1="ENC:"_$P(CENC,U,2)
..S DATA=$G(^AUPNVSIT(IEN,0))
..S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1),VIEN=IEN
I +VIEN D
.;Set a new begin date of 3 years prior to the visit for pap results
.N X1,X2,X S X1=BGPEDATE,X2=-1095 D C^%DTC S BGPPAP=X
.S BGPBIRTH=$P(^DPT(DFN,0),U,3)
.I BGPBIRTH="" S BGPBIRTH=BGPENC
.;Quit if patient has a hysterectomy on record
.;Check CPT codes
.S BGPHYS1=$$CPT^BGPMUUT1(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY CPT")
.I +BGPHYS1 S VALUE=BGPHYS1,RETVAL=1 Q
.;Check ICD procedure codes
.S BGPHYS2=$$LASTPRC^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY ICD")
.I +BGPHYS2 S VALUE=BGPHYS2,RETVAL=1 Q
.;Check POV codes
.S BGPHYS3=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY DX")
.I +BGPHYS3 S VALUE=BGPHYS3,RETVAL=1 Q
.;Check problem list
.S BGPHYS4=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYSTERECTOMY DX")
.I +BGPHYS4 S VALUE=BGPHYS4,RETVAL=1 Q
.;getting here means the patient is in the denominator
.S BGPDSTR=$P(VDATE,".",1)
.;Check for pap smears in the last 3 years
.;Check CPT codes
.S BGPPAP1=$$CPT^BGPMUUT1(DFN,BGPPAP,BGPEDATE,"BGPMU PAP CPTS")
.I +BGPPAP1=1 S RESULT=BGPPAP1,RETVAL=1,STRING2="PAPC:"_$P(BGPPAP1,U,2),BGPNSTR=$P(BGPPAP1,U,2)_";"_$P($P(BGPPAP1,U,3),".",1)
.E D ;Check for LOINC codes
..S BGPPAP2=$$LOINC^BGPMUUT2(DFN,BGPPAP,BGPEDATE,"BGPMU LAB LOINC PAP")
..I +BGPPAP2 D
...S RESULT=BGPPAP2,RETVAL=1
...I STRING2="" S STRING2="PAPL:"_$P(BGPPAP2,U,2)
...E S STRING2=STRING2_",PAPL:"_$P(BGPPAP2,U,2)
...S BGPNSTR=$P($G(^AUPNVLAB($P(BGPPAP2,U,2),11)),U,13)_";"_$P($P(BGPPAP2,U,1),".",1)
..E D ;Check V PROCEDURE and V POV
...S BGPPAP3=$$LASTDX^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU PAP ENC DX")
...I +BGPPAP3=1 D
....S RESULT=BGPPAP3,RETVAL=1
....I STRING2="" S STRING2="PAPD:"_$P(BGPPAP3,U,2)
....E S STRING2=STRING2_",PAPD:"_$P(BGPPAP3,U,2)
....S BGPNSTR=$P(BGPPAP3,U,2)_";"_$P($P(BGPPAP3,U,3),".",1)
...S BGPPAP4=$$LASTPRC^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU PAP ICD0")
...I +BGPPAP4=1 D
....S RESULT=BGPPAP4,RETVAL=1
....I STRING2="" S STRING2="PAPP:"_$P(BGPPAP4,U,2)
....E S STRING2=STRING2_",PAPP:"_$P(BGPPAP4,U,2)
....S BGPNSTR=$P(BGPPAP4,U,2)_";"_$P($P(BGPPAP4,U,3),".",1)
.D TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR)
Q
TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR) ;See where this patient ends up
N PTCNT,EXCCT,DENCT,NUMCT,TOTALS
S TOTALS=$G(^TMP("BGPMU0032",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0032",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0032",$J,BGPMUTF,"NUM"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
;Do not include those with total hysterectomy in the denominator
Q:+VALUE
S DENCT=DENCT+1 S ^TMP("BGPMU0032",$J,BGPMUTF,"DEN")=DENCT
I +RESULT D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0032",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0032",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING1_U_STRING2_U_BGPDSTR_U_BGPNSTR
E I BGPMUTF="C" S ^TMP("BGPMU0032",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING1_U_STRING2_U_BGPDSTR_U_BGPNSTR
S ^TMP("BGPMU0032",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0032.1",BGPMUTF)=1_U_+RESULT_U_""_U_$G(BGPDSTR)_";"_$G(BGPNSTR)
Q
BGPMUA04 ; IHS/MSC/MGH - MI measure NQF0032 ;01-Mar-2011 15:37;MGH
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;Code to collect meaningful use report for cervical cancer screening
ENTRY ;EP
+1 NEW START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC
+2 NEW IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,EXCEPT,FIRST,REF,VIEN,EXCEPT,RESULT
+3 NEW BGPN1,BGPN3,RETVAL,BGPBII,BGPUNII,BGPMUMAM,BGPMAS,AENC,BENC,CENC
+4 NEW BGPENC,BGPPAP,BGPBIRTH,BGPHYS2,BGPHYS1,BGPHYS3,BGPHYS4,BGPPAP1,BGPPAP2,BGPPAP3,BGPPAP4,BGPDSTR,BGPNSTR
+5 NEW BGPPAP2,STRING1,STRING2
+6 SET (BGPDEN,BGPNUM,RESULT)=0
+7 SET (STRING1,STRING2,BGPDSTR,BGPNSTR)=""
+8 ;Set a new begin date of 2 years prior reporting period end date
+9 NEW X1,X2,X
SET X1=BGPEDATE
SET X2=-730
DO C^%DTC
SET BGPENC=X
+10 SET START=9999999-BGPENC
SET END=9999999-BGPEDATE
SET VALUE=0
+11 ;Return value
SET (RETVAL,VIEN)=""
+12 ;Patients must be female
IF BGPSEX="M"
QUIT
+13 ;Pts must be 23-63
+14 ;No need to check further if no age match
+15 IF (BGPAGEB<23)!(BGPAGEB>63)
QUIT
+16 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START)!(VIEN]"")
QUIT
Begin DoDot:1
+17 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(VIEN]"")
QUIT
Begin DoDot:2
+18 ;Check provider, Only visits for chosen provider
+19 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+20 ;Quit if any visit in the last 2 years does not have a valid E&M code
+21 SET AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU MAMMOGRAM ENC EM")
+22 SET BENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU MAMMOGRAM ENC ICD")
+23 SET CENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU OBGYN ENC DX")
+24 IF (AENC=0)&(BENC=0)&(CENC=0)
QUIT
+25 IF AENC
SET STRING1="ENC:"_$PIECE(AENC,U,2)
+26 IF BENC
SET STRING1="ENC:"_$PIECE(BENC,U,2)
+27 IF CENC
SET STRING1="ENC:"_$PIECE(CENC,U,2)
+28 SET DATA=$GET(^AUPNVSIT(IEN,0))
+29 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
SET VIEN=IEN
End DoDot:2
End DoDot:1
+30 IF +VIEN
Begin DoDot:1
+31 ;Set a new begin date of 3 years prior to the visit for pap results
+32 NEW X1,X2,X
SET X1=BGPEDATE
SET X2=-1095
DO C^%DTC
SET BGPPAP=X
+33 SET BGPBIRTH=$PIECE(^DPT(DFN,0),U,3)
+34 IF BGPBIRTH=""
SET BGPBIRTH=BGPENC
+35 ;Quit if patient has a hysterectomy on record
+36 ;Check CPT codes
+37 SET BGPHYS1=$$CPT^BGPMUUT1(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY CPT")
+38 IF +BGPHYS1
SET VALUE=BGPHYS1
SET RETVAL=1
QUIT
+39 ;Check ICD procedure codes
+40 SET BGPHYS2=$$LASTPRC^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY ICD")
+41 IF +BGPHYS2
SET VALUE=BGPHYS2
SET RETVAL=1
QUIT
+42 ;Check POV codes
+43 SET BGPHYS3=$$LASTDX^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU HYSTERECTOMY DX")
+44 IF +BGPHYS3
SET VALUE=BGPHYS3
SET RETVAL=1
QUIT
+45 ;Check problem list
+46 SET BGPHYS4=$$PLTAX^BGPMUUT1(DFN,"BGPMU HYSTERECTOMY DX")
+47 IF +BGPHYS4
SET VALUE=BGPHYS4
SET RETVAL=1
QUIT
+48 ;getting here means the patient is in the denominator
+49 SET BGPDSTR=$PIECE(VDATE,".",1)
+50 ;Check for pap smears in the last 3 years
+51 ;Check CPT codes
+52 SET BGPPAP1=$$CPT^BGPMUUT1(DFN,BGPPAP,BGPEDATE,"BGPMU PAP CPTS")
+53 IF +BGPPAP1=1
SET RESULT=BGPPAP1
SET RETVAL=1
SET STRING2="PAPC:"_$PIECE(BGPPAP1,U,2)
SET BGPNSTR=$PIECE(BGPPAP1,U,2)_";"_$PIECE($PIECE(BGPPAP1,U,3),".",1)
+54 ;Check for LOINC codes
IF '$TEST
Begin DoDot:2
+55 SET BGPPAP2=$$LOINC^BGPMUUT2(DFN,BGPPAP,BGPEDATE,"BGPMU LAB LOINC PAP")
+56 IF +BGPPAP2
Begin DoDot:3
+57 SET RESULT=BGPPAP2
SET RETVAL=1
+58 IF STRING2=""
SET STRING2="PAPL:"_$PIECE(BGPPAP2,U,2)
+59 IF '$TEST
SET STRING2=STRING2_",PAPL:"_$PIECE(BGPPAP2,U,2)
+60 SET BGPNSTR=$PIECE($GET(^AUPNVLAB($PIECE(BGPPAP2,U,2),11)),U,13)_";"_$PIECE($PIECE(BGPPAP2,U,1),".",1)
End DoDot:3
+61 ;Check V PROCEDURE and V POV
IF '$TEST
Begin DoDot:3
+62 SET BGPPAP3=$$LASTDX^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU PAP ENC DX")
+63 IF +BGPPAP3=1
Begin DoDot:4
+64 SET RESULT=BGPPAP3
SET RETVAL=1
+65 IF STRING2=""
SET STRING2="PAPD:"_$PIECE(BGPPAP3,U,2)
+66 IF '$TEST
SET STRING2=STRING2_",PAPD:"_$PIECE(BGPPAP3,U,2)
+67 SET BGPNSTR=$PIECE(BGPPAP3,U,2)_";"_$PIECE($PIECE(BGPPAP3,U,3),".",1)
End DoDot:4
+68 SET BGPPAP4=$$LASTPRC^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU PAP ICD0")
+69 IF +BGPPAP4=1
Begin DoDot:4
+70 SET RESULT=BGPPAP4
SET RETVAL=1
+71 IF STRING2=""
SET STRING2="PAPP:"_$PIECE(BGPPAP4,U,2)
+72 IF '$TEST
SET STRING2=STRING2_",PAPP:"_$PIECE(BGPPAP4,U,2)
+73 SET BGPNSTR=$PIECE(BGPPAP4,U,2)_";"_$PIECE($PIECE(BGPPAP4,U,3),".",1)
End DoDot:4
End DoDot:3
End DoDot:2
+74 DO TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR)
End DoDot:1
+75 QUIT
TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS
+2 SET TOTALS=$GET(^TMP("BGPMU0032",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0032",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0032",$JOB,BGPMUTF,"NUM"))
+5 SET PTCNT=TOTALS
+6 SET PTCNT=PTCNT+1
+7 ;Do not include those with total hysterectomy in the denominator
+8 IF +VALUE
QUIT
+9 SET DENCT=DENCT+1
SET ^TMP("BGPMU0032",$JOB,BGPMUTF,"DEN")=DENCT
+10 IF +RESULT
Begin DoDot:1
+11 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0032",$JOB,BGPMUTF,"NUM")=NUMCT
+12 IF BGPMUTF="C"
SET ^TMP("BGPMU0032",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING1_U_STRING2_U_BGPDSTR_U_BGPNSTR
End DoDot:1
+13 IF '$TEST
IF BGPMUTF="C"
SET ^TMP("BGPMU0032",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING1_U_STRING2_U_BGPDSTR_U_BGPNSTR
+14 SET ^TMP("BGPMU0032",$JOB,BGPMUTF,"TOT")=PTCNT
+15 ;Setup iCare array for patient
+16 SET BGPICARE("MU.EP.0032.1",BGPMUTF)=1_U_+RESULT_U_""_U_$GET(BGPDSTR)_";"_$GET(BGPNSTR)
+17 QUIT
