Routine: BGPMUG07

BGPMUG07 ; IHS/MSC/MMT - MI measure NQF0389 ;06-Sep-2011 13:06;DU

 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 ;Code to collect meaningful use reports

ENTRY ;EP Entry point for Prostate Cancer

 N START,END,STRING

 N IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN

 N CNT,DEN,NUM,EXC,OUTENC,PROSTDX

 S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0

 S START=START_".2359"

 S (STRING,STRING2)=""

 S (DEN,EXC,NUM)=0

 ;Must be Male

 Q:BGPSEX="F"

 ;First check for Prostate Cancer Dx since that will eliminate most patients

 S BGPBIRTH=$$DOB^AUPNPAT(DFN)

 S PROSTDX=$$PROSTATE(DFN,BGPBIRTH,BGPEDATE)

 Q:'PROSTDX

 S CNT=0

 S FIRST=END-0.1 F  S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START)  D

 .S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,FIRST,IEN)) Q:'+IEN  D

 ..;Check provider, Only visits for chosen provider

 ..Q:'$$PRV^BGPMUUT1(IEN,BGPPROV)

 ..S OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU PROSTATE OUTPT ENC")

 ..I +OUTENC D VSTSTORE Q

 ;Next check to see if the patient is in the denominator

 S DEN=$$DEN(DFN,BGPBDATE,BGPEDATE,CNT,.VIEN,PROSTDX)

 I +DEN D

 .;If the patient is in denominator, check to see if they are in the numerator

 .S NUM=$$NUM1(DFN,$P(PROSTDX,U,3),$P(DEN,U,2))

 .;If not in the numerator,see if they are an exception

 .I +NUM=0 S EXC=$$EXCEPT(DFN,$P(PROSTDX,U,3),$P(DEN,U,2),.VIEN)

 .D TOTAL1(DFN,DEN,NUM,EXC)

VSTSTORE ;Store compliant visit in array

 S CNT=CNT+1

 S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1)

 S VIEN(CNT)=IEN_U_VDATE

 S STRING(CNT)=$$DATE^BGPMUUTL(VDATE)

TOTAL1(DFN,DEN,NUM,EXC) ;See where this patient ends up

 N PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME

 S TOTALS=+$G(^TMP("BGPMU0389",$J,BGPMUTF,"TOT"))

 S DENCT=+$G(^TMP("BGPMU0389",$J,BGPMUTF,"DEN"))

 S NUMCT=+$G(^TMP("BGPMU0389",$J,BGPMUTF,"NUM"))

 S EXCCT=+$G(^TMP("BGPMU0389",$J,BGPMUTF,"EXC"))

 S NOTNUM=+$G(^TMP("BGPMU0389",$J,BGPMUTF,"NOT"))

 S PTCNT=TOTALS

 S PTCNT=PTCNT+1

 S DENCT=DENCT+1 S ^TMP("BGPMU0389",$J,BGPMUTF,"DEN")=DENCT

 S DENSTR=$P(DEN,U,3)

 I +EXC D

 .S EXCCT=EXCCT+1 S ^TMP("BGPMU0389",$J,BGPMUTF,"EXC")=EXCCT

 .I BGPMUTF="C" S ^TMP("BGPMU0389",$J,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"

 I +NUM D

 .S NUMCT=NUMCT+1 S ^TMP("BGPMU0389",$J,BGPMUTF,"NUM")=NUMCT

 .I BGPMUTF="C" S ^TMP("BGPMU0389",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:"_$P(NUM,U,2)

 I +NUM=0&(+EXC=0) D

 .S NOTNUM=NOTNUM+1 S ^TMP("BGPMU0389",$J,BGPMUTF,"NOT")=NOTNUM

 .I BGPMUTF="C" S ^TMP("BGPMU0389",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"_$P(NUM,U,2)

 S ^TMP("BGPMU0389",$J,BGPMUTF,"TOT")=PTCNT

 ;Setup iCare array for patient

 S BGPICARE("MU.EP.0389.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$P(NUM,U,2)

PROSTATE(DFN,BDATE,EDATE) ;Look for Prostate Cancer V POV or PROBLEM

 N DX

 S DX=0

 S DX=$$LASTDX^BGPMUUT2(DFN,BDATE,EDATE,"BGPMU PROSTATE CANCER DX")

 I +DX Q 1_U_$P(DX,U,2,3)

 S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU PROSTATE CANCER DX","C",EDATE)

 I +DX Q 2_U_$P(DX,U,2,3)

 Q DX

DEN(DFN,BGPBDATE,BGPEDATE,CNT,VIEN,PROSTDX) ;Check if Pt is in denominator

 N TRTMNT,PROC,PROCDT,AJCC,ANTIG,VLABIEN,ANTIVAL,GLETST,GLEVAL,DATA

 K DATA

 S TRTMNT=0,ANTIVAL=""

 ;Treatment procedure done?

 S PROC=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU PROSTATE CANCER TRMT CPT")

 G:'PROC DENQ

 S PROCDT=$P(PROC,U,3)

 ;Stage eval?

 S AJCC=$$CPT^BGPMUUT1(DFN,"",PROCDT,"BGPMU PROSTATE CANCER STAGE")

 G:'AJCC DENQ

 ;Antigen tested?

 S ANTIG=$$LOINC^BGPMUUT2(DFN,"",PROCDT,"BGPMU LAB LOINC PROSTATE ANTIG")

 I +ANTIG D

 .S VLABIEN=$P(ANTIG,U,2)

 .S ANTIVAL=$P($G(^AUPNVLAB(VLABIEN,0)),U,4)

 E  D

 .D LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT PROSTATE ANTIGEN","",PROCDT)

 .S VAL="" S VAL=$O(DATA(VAL))

 .I +VAL D

 ..S ANTIVAL=$G(DATA(VAL))

 ..S ANTIG=(9999999-VAL)_U_ANTIVAL

 G:ANTIVAL="" DENQ

 ;Gleason test performed?

 S GLETST=$$LOINC^BGPMUUT2(DFN,"",PROCDT,"BGPMU LAB LOINC GLEASON TEST")

 G:'GLETST DENQ

 S VLABIEN=$P(GLETST,U,2)

 S GLEVAL=$P($G(^AUPNVLAB(VLABIEN,0)),U,4)

 G:GLEVAL="" DENQ

 ;check values and set return var

 S:(ANTIVAL<=10)&(GLEVAL<=6) TRTMNT=1_U_PROCDT_U_$$DENSTR(DFN)

DENQ Q TRTMNT

DENSTR(DFN) ;Generate display string for Denom

 N STRING

 S STRING="PCDX:"_$$DATE^BGPMUUTL($P(PROSTDX,U,3))

 S STRING=STRING_";PCTM:"_$$DATE^BGPMUUTL(PROCDT)

 S STRING=STRING_";AJCC:"_$$DATE^BGPMUUTL($P(AJCC,U,3))

 S STRING=STRING_";ANT:"_$$DATE^BGPMUUTL($P(ANTIG,U))

 S STRING=STRING_";GLE:"_$$DATE^BGPMUUTL($P(GLETST,U))

 Q STRING

NUM1(DFN,BDATE,EDATE) ;This one has backward Numerator logic - return 1 if NOT met

 N FOUND,PMED

 S FOUND=1

 ;Look for V RADIOLOGY event for bone scan study

 S SCAN=$$RAD^BGPMUUT1(DFN,BDATE,EDATE,"BGPMU PROSTATE BONE SCAN CPT",7)

 ;return TRUE if no bone scan study found

 I +SCAN Q 0_U_"BSDS:"_$$DATE^BGPMUUTL($P(SCAN,U))

 ;Look for ORDER for bone scan study

 S SCAN=$$FIND^BGPMUUT7(DFN,"BGPMU PROSTATE BONE SCAN CPT",BDATE,EDATE) ;RAD procedure check

 I +SCAN Q 0_U_"BSDS:"_$$DATE^BGPMUUTL($P(SCAN,U))

 Q FOUND

EXCEPT(DFN,BDATE,EDATE,VIEN) ;Check exclusion criteria

 N LAST,RESULT,OOP,RAD,CHEMO,METDX,METPL,PMED,ALLER,REF,TAX

 S RESULT=0

 S DX=$$LASTDX^BGPMUUT2(DFN,BDATE,EDATE,"BGPMU 0389 EXCLUSIONS DX")

 I +DX S RESULT=1 Q RESULT

 S DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU 0389 EXCLUSIONS DX","C",EDATE)

 I +DX S RESULT=1 Q RESULT

 S PROC=$$CPT^BGPMUUT1(DFN,BDATE,EDATE,"BGPMU 0389 EXCLUSIONS CPT")

 I +PROC S RESULT=1 Q RESULT

 Q RESULT

BGPMUG07  ; IHS/MSC/MMT - MI measure NQF0389 ;06-Sep-2011 13:06;DU

 +1       ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106

 +2       ;Code to collect meaningful use reports

ENTRY     ;EP Entry point for Prostate Cancer

 +1        NEW START,END,STRING

 +2        NEW IEN,INV,VISIT,DATA,VDATE,VALUE,EXCEPT,FIRST,VIEN

 +3        NEW CNT,DEN,NUM,EXC,OUTENC,PROSTDX

 +4        SET START=9999999-BGPBDATE

           SET END=9999999-BGPEDATE

           SET VALUE=0

 +5        SET START=START_".2359"

 +6        SET (STRING,STRING2)=""

 +7        SET (DEN,EXC,NUM)=0

 +8       ;Must be Male

 +9        IF BGPSEX="F"

               QUIT

 +10      ;First check for Prostate Cancer Dx since that will eliminate most patients

 +11       SET BGPBIRTH=$$DOB^AUPNPAT(DFN)

 +12       SET PROSTDX=$$PROSTATE(DFN,BGPBIRTH,BGPEDATE)

 +13       IF 'PROSTDX

               QUIT

 +14       SET CNT=0

 +15       SET FIRST=END-0.1

FOR

               SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))

               IF FIRST=""!($PIECE(FIRST,".",1)>START)

                   QUIT

               Begin DoDot:1

 +16               SET IEN=0

FOR

                       SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))

                       IF '+IEN

                           QUIT

                       Begin DoDot:2

 +17      ;Check provider, Only visits for chosen provider

 +18                       IF '$$PRV^BGPMUUT1(IEN,BGPPROV)

                               QUIT

 +19                       SET OUTENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU PROSTATE OUTPT ENC")

 +20                       IF +OUTENC

                               DO VSTSTORE

                               QUIT

                       End DoDot:2

               End DoDot:1

 +21      ;Next check to see if the patient is in the denominator

 +22       SET DEN=$$DEN(DFN,BGPBDATE,BGPEDATE,CNT,.VIEN,PROSTDX)

 +23       IF +DEN

               Begin DoDot:1

 +24      ;If the patient is in denominator, check to see if they are in the numerator

 +25               SET NUM=$$NUM1(DFN,$PIECE(PROSTDX,U,3),$PIECE(DEN,U,2))

 +26      ;If not in the numerator,see if they are an exception

 +27               IF +NUM=0

                       SET EXC=$$EXCEPT(DFN,$PIECE(PROSTDX,U,3),$PIECE(DEN,U,2),.VIEN)

 +28               DO TOTAL1(DFN,DEN,NUM,EXC)

               End DoDot:1

 +29       QUIT

VSTSTORE  ;Store compliant visit in array

 +1        SET CNT=CNT+1

 +2        SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)

 +3        SET VIEN(CNT)=IEN_U_VDATE

 +4        SET STRING(CNT)=$$DATE^BGPMUUTL(VDATE)

 +5        QUIT

TOTAL1(DFN,DEN,NUM,EXC) ;See where this patient ends up

 +1        NEW PTCNT,EXCCT,DENCT,NUMCT,NOTNUM,TOTALS,DXTIME

 +2        SET TOTALS=+$GET(^TMP("BGPMU0389",$JOB,BGPMUTF,"TOT"))

 +3        SET DENCT=+$GET(^TMP("BGPMU0389",$JOB,BGPMUTF,"DEN"))

 +4        SET NUMCT=+$GET(^TMP("BGPMU0389",$JOB,BGPMUTF,"NUM"))

 +5        SET EXCCT=+$GET(^TMP("BGPMU0389",$JOB,BGPMUTF,"EXC"))

 +6        SET NOTNUM=+$GET(^TMP("BGPMU0389",$JOB,BGPMUTF,"NOT"))

 +7        SET PTCNT=TOTALS

 +8        SET PTCNT=PTCNT+1

 +9        SET DENCT=DENCT+1

           SET ^TMP("BGPMU0389",$JOB,BGPMUTF,"DEN")=DENCT

 +10       SET DENSTR=$PIECE(DEN,U,3)

 +11       IF +EXC

               Begin DoDot:1

 +12               SET EXCCT=EXCCT+1

                   SET ^TMP("BGPMU0389",$JOB,BGPMUTF,"EXC")=EXCCT

 +13               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0389",$JOB,"PAT",BGPMUTF,"EXC",PTCNT)=DFN_U_DENSTR_U_"Excluded"

               End DoDot:1

 +14       IF +NUM

               Begin DoDot:1

 +15               SET NUMCT=NUMCT+1

                   SET ^TMP("BGPMU0389",$JOB,BGPMUTF,"NUM")=NUMCT

 +16               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0389",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_DENSTR_U_"M:"_$PIECE(NUM,U,2)

               End DoDot:1

 +17       IF +NUM=0&(+EXC=0)

               Begin DoDot:1

 +18               SET NOTNUM=NOTNUM+1

                   SET ^TMP("BGPMU0389",$JOB,BGPMUTF,"NOT")=NOTNUM

 +19               IF BGPMUTF="C"

                       SET ^TMP("BGPMU0389",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_DENSTR_U_"NM:"_$PIECE(NUM,U,2)

               End DoDot:1

 +20       SET ^TMP("BGPMU0389",$JOB,BGPMUTF,"TOT")=PTCNT

 +21      ;Setup iCare array for patient

 +22       SET BGPICARE("MU.EP.0389.1",BGPMUTF)=1_U_+NUM_U_+EXC_U_DENSTR_";"_$PIECE(NUM,U,2)

 +23       QUIT

PROSTATE(DFN,BDATE,EDATE) ;Look for Prostate Cancer V POV or PROBLEM

 +1        NEW DX

 +2        SET DX=0

 +3        SET DX=$$LASTDX^BGPMUUT2(DFN,BDATE,EDATE,"BGPMU PROSTATE CANCER DX")

 +4        IF +DX

               QUIT 1_U_$PIECE(DX,U,2,3)

 +5        SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU PROSTATE CANCER DX","C",EDATE)

 +6        IF +DX

               QUIT 2_U_$PIECE(DX,U,2,3)

 +7        QUIT DX

DEN(DFN,BGPBDATE,BGPEDATE,CNT,VIEN,PROSTDX) ;Check if Pt is in denominator

 +1        NEW TRTMNT,PROC,PROCDT,AJCC,ANTIG,VLABIEN,ANTIVAL,GLETST,GLEVAL,DATA

 +2        KILL DATA

 +3        SET TRTMNT=0

           SET ANTIVAL=""

 +4       ;Treatment procedure done?

 +5        SET PROC=$$CPT^BGPMUUT1(DFN,BGPBDATE,BGPEDATE,"BGPMU PROSTATE CANCER TRMT CPT")

 +6        IF 'PROC

               GOTO DENQ

 +7        SET PROCDT=$PIECE(PROC,U,3)

 +8       ;Stage eval?

 +9        SET AJCC=$$CPT^BGPMUUT1(DFN,"",PROCDT,"BGPMU PROSTATE CANCER STAGE")

 +10       IF 'AJCC

               GOTO DENQ

 +11      ;Antigen tested?

 +12       SET ANTIG=$$LOINC^BGPMUUT2(DFN,"",PROCDT,"BGPMU LAB LOINC PROSTATE ANTIG")

 +13       IF +ANTIG

               Begin DoDot:1

 +14               SET VLABIEN=$PIECE(ANTIG,U,2)

 +15               SET ANTIVAL=$PIECE($GET(^AUPNVLAB(VLABIEN,0)),U,4)

               End DoDot:1

 +16      IF '$TEST

               Begin DoDot:1

 +17               DO LABCPT^BGPMUUT5(.DATA,DFN,"BGPMU LAB CPT PROSTATE ANTIGEN","",PROCDT)

 +18               SET VAL=""

                   SET VAL=$ORDER(DATA(VAL))

 +19               IF +VAL

                       Begin DoDot:2

 +20                       SET ANTIVAL=$GET(DATA(VAL))

 +21                       SET ANTIG=(9999999-VAL)_U_ANTIVAL

                       End DoDot:2

               End DoDot:1

 +22       IF ANTIVAL=""

               GOTO DENQ

 +23      ;Gleason test performed?

 +24       SET GLETST=$$LOINC^BGPMUUT2(DFN,"",PROCDT,"BGPMU LAB LOINC GLEASON TEST")

 +25       IF 'GLETST

               GOTO DENQ

 +26       SET VLABIEN=$PIECE(GLETST,U,2)

 +27       SET GLEVAL=$PIECE($GET(^AUPNVLAB(VLABIEN,0)),U,4)

 +28       IF GLEVAL=""

               GOTO DENQ

 +29      ;check values and set return var

 +30       IF (ANTIVAL<=10)&(GLEVAL<=6)

               SET TRTMNT=1_U_PROCDT_U_$$DENSTR(DFN)

DENQ       QUIT TRTMNT

DENSTR(DFN) ;Generate display string for Denom

 +1        NEW STRING

 +2        SET STRING="PCDX:"_$$DATE^BGPMUUTL($PIECE(PROSTDX,U,3))

 +3        SET STRING=STRING_";PCTM:"_$$DATE^BGPMUUTL(PROCDT)

 +4        SET STRING=STRING_";AJCC:"_$$DATE^BGPMUUTL($PIECE(AJCC,U,3))

 +5        SET STRING=STRING_";ANT:"_$$DATE^BGPMUUTL($PIECE(ANTIG,U))

 +6        SET STRING=STRING_";GLE:"_$$DATE^BGPMUUTL($PIECE(GLETST,U))

 +7        QUIT STRING

NUM1(DFN,BDATE,EDATE) ;This one has backward Numerator logic - return 1 if NOT met

 +1        NEW FOUND,PMED

 +2        SET FOUND=1

 +3       ;Look for V RADIOLOGY event for bone scan study

 +4        SET SCAN=$$RAD^BGPMUUT1(DFN,BDATE,EDATE,"BGPMU PROSTATE BONE SCAN CPT",7)

 +5       ;return TRUE if no bone scan study found

 +6        IF +SCAN

               QUIT 0_U_"BSDS:"_$$DATE^BGPMUUTL($PIECE(SCAN,U))

 +7       ;Look for ORDER for bone scan study

 +8       ;RAD procedure check

           SET SCAN=$$FIND^BGPMUUT7(DFN,"BGPMU PROSTATE BONE SCAN CPT",BDATE,EDATE)

 +9        IF +SCAN

               QUIT 0_U_"BSDS:"_$$DATE^BGPMUUTL($PIECE(SCAN,U))

 +10       QUIT FOUND

EXCEPT(DFN,BDATE,EDATE,VIEN) ;Check exclusion criteria

 +1        NEW LAST,RESULT,OOP,RAD,CHEMO,METDX,METPL,PMED,ALLER,REF,TAX

 +2        SET RESULT=0

 +3        SET DX=$$LASTDX^BGPMUUT2(DFN,BDATE,EDATE,"BGPMU 0389 EXCLUSIONS DX")

 +4        IF +DX

               SET RESULT=1

               QUIT RESULT

 +5        SET DX=$$PLTAX^BGPMUUT1(DFN,"BGPMU 0389 EXCLUSIONS DX","C",EDATE)

 +6        IF +DX

               SET RESULT=1

               QUIT RESULT

 +7        SET PROC=$$CPT^BGPMUUT1(DFN,BDATE,EDATE,"BGPMU 0389 EXCLUSIONS CPT")

 +8        IF +PROC

               SET RESULT=1

               QUIT RESULT

 +9        QUIT RESULT

BGPMUG07.m