BGPMUA04.m

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