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)
Q
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)
Q
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)
Q
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
