BGPMUA03 ; IHS/MSC/MGH - MI measure NQF0031 ;29-Nov-2011 7:37;MMT
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;Code to collect meaningful use report for breast cancer screening
ENTRY ;EP
; expects:
; DFN = patient code from VA PATIENT file
; BGPBDATE = begin date of report
; BGPEDATE = end date of report
; BGPPROV = provider code from NEW PERSON file
; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
N START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC,BGPX,MASTCNT
N IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,RESULT,FIRST,REF,VIEN,EXCEPT
N BGPN1,BGPN3,RETVAL,BGPMUMAM,BGPMAS,AENC,BENC,BGPBIRTH,BGPMAM,BGPMAM2,BGPMAM3,BGPMAM4
N BGPENC,BGPBICPT,BGPUICPT,BGPBIICD,BGPUIICD,STRING1,STRING2
N BGPDT,BGPDSTR,BGPNSTR
S (BGPDEN,BGPNUM,RESULT)=0
S (BGPDSTR,BGPNSTR)=""
S START=9999999-BGPBDATE,END=9999999-BGPEDATE,VALUE=0
S START2Y=9999999-$$FMADD^XLFDT(BGPEDATE,-730)
S RETVAL="",VIEN="" ;Return value
S BGPSEX=$$SEX^AUPNPAT(DFN)
Q:BGPSEX="M" ;Patients must be female
;Pts must be 41-69
;No need to check further if no age match
Q:(BGPAGEE<41)!(BGPAGEE>68)
;find outpatient encounter with provider within 2 years of BGPEDATE
S FIRST=END-0.1 F S FIRST=$O(^AUPNVSIT("AA",DFN,FIRST)) Q:FIRST=""!($P(FIRST,".",1)>START2Y)!(+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)
..;Check E&M
..S AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU MAMMOGRAM ENC EM")
..S BENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU MAMMOGRAM ENC ICD")
..Q:(AENC=0)&(BENC=0)
..S DATA=$G(^AUPNVSIT(IEN,0))
..S VDATE=$P($G(^AUPNVSIT(IEN,0)),U,1),VIEN=IEN
I +VIEN D
.S (STRING1,STRING2)=""
.K BGPX
.S MASTCNT=0
.;Set a new begin date of 2 years prior to the visit
.N X1,X2,X S X1=VDATE,X2=-730 D C^%DTC S BGPENC=X
.S BGPDT=$P($P($G(^AUPNVSIT(VIEN,0)),U,1),".",1)
.I AENC S STRING1="ENCC:"_$P(AENC,U,2)
.I BENC S STRING1="ENCC:"_$P(BENC,U,2)
.S BGPBIRTH=$P(^DPT(DFN,0),U,3)
.I BGPBIRTH="" S BGPBIRTH=BGPENC
.;First, check for bilateral mastectomy
.S BGPBICPT=$$CPT("B")
.I +BGPBICPT S VALUE=BGPBICPT,RETVAL=1 Q
.;Then check for 2 unilateral CPT codes
.S BGPUICPT=$$CPT("U")
.I +BGPUICPT S VALUE=BGPUICPT,RETVAL=1 Q
.;Quit if patient has ICD0 code for bilateral mastectomy on record
.S BGPBIICD=$$LASTPRC^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU BILAT MASTECTOMY ICD")
.I +BGPBIICD S VALUE=BGPBIICD,RETVAL=1 Q
.;Check for 2 unilateral ICD0 codes
.S BGPUIICD=$$ICD0("U")
.I +BGPUIICD S VALUE=BGPUIICD,RETVAL=1 Q
.;getting here means the patient is in the denominator
.S BGPDSTR=BGPDT
.;Check for mammogram in the last 2 years
.S BGPMAM=$$CPT^BGPMUUT1(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM CPTS")
.I +BGPMAM=1 S RESULT=BGPMAM
.S BGPMAM2=$$LASTPRC^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM ICD")
.I +BGPMAM2=1 S RESULT=BGPMAM2
.S BGPMAM3=$$LASTDX^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM DX")
.I +BGPMAM3=1 S RESULT=BGPMAM3
.S BGPMAM4=$$RAD^BGPMUUT1(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM CPTS",7)
.I +BGPMAM4 S RESULT=1_U_BGPMAM4
.I +BGPMAM S STRING2="MAMC:"_$P(BGPMAM,U,2),BGPNSTR=$P(BGPMAM,U,2)_";"_$P($P(BGPMAM,U,3),".",1)
.I +BGPMAM2 D
..I STRING2="" S STRING2="MAMP:"+$P(BGPMAM2,U,2),BGPNSTR=$P(BGPMAM2,U,2)_";"_$P($P(BGPMAM2,U,3),".",1)
..I STRING2'="" S STRING2=STRING2_";MAMP:"+$P(BGPMAM2,U,2),BGPNSTR=$P(BGPMAM2,U,2)_";"_$P($P(BGPMAM2,U,3),".",1)
.I +BGPMAM3 D
..I STRING2="" S STRING2="MAMD:"+$P(BGPMAM3,U,2),BGPNSTR=$P(BGPMAM3,U,2)_";"_$P($P(BGPMAM3,U,3),".",1)
..I STRING2'="" S STRING2=STRING2_";MAMD:"+$P(BGPMAM3,U,2),BGPNSTR=$P(BGPMAM3,U,2)_";"_$P($P(BGPMAM3,U,3),".",1)
.I +BGPMAM4 D
..I STRING2="" S STRING2="MAMC:"+$P(BGPMAM4,U,2),BGPNSTR=$P(BGPMAM4,U,2)_";"_$P($P(BGPMAM4,U,1),".",1)
..I STRING2'="" S STRING2=STRING2_";MAMC:"+$P(BGPMAM4,U,2),BGPNSTR=$P(BGPMAM4,U,2)_";"_$P($P(BGPMAM4,U,1),".",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("BGPMU0031",$J,BGPMUTF,"TOT"))
S DENCT=+$G(^TMP("BGPMU0031",$J,BGPMUTF,"DEN"))
S NUMCT=+$G(^TMP("BGPMU0031",$J,BGPMUTF,"NUM"))
S NOTCT=+$G(^TMP("BGPMU0031",$J,BGPMUTF,"NOT"))
S PTCNT=TOTALS
S PTCNT=PTCNT+1
;Do not include those with 2 mastectomies in the denominator
Q:+VALUE
S DENCT=DENCT+1 S ^TMP("BGPMU0031",$J,BGPMUTF,"DEN")=DENCT
I +RESULT D
.S NUMCT=NUMCT+1 S ^TMP("BGPMU0031",$J,BGPMUTF,"NUM")=NUMCT
.I BGPMUTF="C" S ^TMP("BGPMU0031",$J,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING1_U_STRING2_U_$G(BGPDSTR)_U_$G(BGPNSTR)
E S ^TMP("BGPMU0031",$J,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_STRING1_U_$G(STRING2)_U_$G(BGPDSTR)_U_$G(BGPNSTR) I BGPMUTF="C" S ^TMP("BGPMU0031",$J,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING1_U_U_$G(BGPDSTR)_U_$G(BGPNSTR)
S ^TMP("BGPMU0031",$J,BGPMUTF,"TOT")=PTCNT
;Setup iCare array for patient
S BGPICARE("MU.EP.0031.1",BGPMUTF)=1_U_+RESULT_U_""_U_$G(BGPDSTR)_";"_$G(BGPNSTR)
Q
CPT(CODE) ;See if the patient has the CPT codes for mastectomy
N VAL,TAX,FOUND,VISIT,CPT,MDATE,CPTCODE,MOD1,MOD2
S VAL=0
;loop through all cpt codes up to Edate and if any match quit
S TAX=$O(^ATXAX("B","BGPMU MASTECTOMY CPT",0))
I TAX S FOUND="" D
.S CPT=0 F S CPT=$O(^AUPNVCPT("AC",DFN,CPT)) Q:CPT'=+CPT!(FOUND]"") D
..S VISIT=$P($G(^AUPNVCPT(CPT,0)),U,3)
..Q:VISIT=""
..S MDATE=$P($P($G(^AUPNVSIT(VISIT,0)),U),".") ;date done
..Q:MDATE=""
..I MDATE>BGPEDATE Q
..S CPTCODE=$P(^AUPNVCPT(CPT,0),U)
..Q:'$$ICD^ATXCHK(CPTCODE,TAX,1)
..S:CODE="U" MASTCNT=MASTCNT+1
..S MOD1=$P(^AUPNVCPT(CPT,0),U,8)
..S MOD2=$P(^AUPNVCPT(CPT,0),U,9)
..D MODIFY(MOD1,MOD2)
I 'FOUND S FOUND=0
Q FOUND
ICD0(CODE) ;See if the patient has the CPT codes for mastectomy
N VAL,TAX,FOUND,VISIT,ICD0,MDATE,ICDCODE,MOD1,MOD2,DATA
S VAL=0,DATA=0
;loop through all ICD0 codes up to Edate and if any match quit
S TAX=$O(^ATXAX("B","BGPMU UNI MASTECTOMY ICDS",0))
I TAX S FOUND="" D
.S ICD0=0 F S ICD0=$O(^AUPNVPRC("AC",DFN,ICD0)) Q:ICD0'=+ICD0!(FOUND]"") D
..S VISIT=$P($G(^AUPNVPRC(ICD0,0)),U,3)
..Q:VISIT=""
..S MDATE=$P($P($G(^AUPNVPRC(ICD0,0)),U,6),".")
..I MDATE="" S MDATE=$P($P($G(^AUPNVSIT(VISIT,0)),U),".") ;date done
..Q:MDATE=""
..I MDATE>BGPEDATE Q
..S ICDCODE=$P(^AUPNVPRC(ICD0,0),U)
..Q:'$$ICD^ATXCHK(ICDCODE,TAX,0)
..S:CODE="U" MASTCNT=MASTCNT+1
..S MOD1=$P(^AUPNVPRC(ICD0,0),U,17)
..S MOD2=$P(^AUPNVPRC(ICD0,0),U,18)
..D MODIFY(MOD1,MOD2)
I 'FOUND S FOUND=0
Q FOUND
MODIFY(MOD1,MOD2) ;Check for modifiers
N MOD,DATE2
S MOD=""
S:MOD1 MOD=$P($G(@$$MODGBL@(MOD1,0)),U,1)
S:MOD2 MOD=$P($G(@$$MODGBL@(MOD2,0)),U,1)
I (MOD1=50)!(MOD2=50) S FOUND=1
I CODE="U"&(MASTCNT=1) D
.S BGPX(MASTCNT)=MDATE_U_MOD
I CODE="U"&(MASTCNT>1) D
.I MDATE'=$P(BGPX(1),U,1) S FOUND=1
Q
MODGBL() Q $S($$CSVACT():"^DIC(81.3)",$G(DUZ("AG"))="I":"^AUTTCMOD",1:"^DIC(81.3)")
CSVACT(RTN) ;EP
Q $S(DUZ("AG")'="I":1,$$VERSION^XPDUTL("BCSV")="":0,'$L($G(RTN)):1,1:$T(+0^@RTN)'="")
BGPMUA03 ; IHS/MSC/MGH - MI measure NQF0031 ;29-Nov-2011 7:37;MMT
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;Code to collect meaningful use report for breast cancer screening
ENTRY ;EP
+1 ; expects:
+2 ; DFN = patient code from VA PATIENT file
+3 ; BGPBDATE = begin date of report
+4 ; BGPEDATE = end date of report
+5 ; BGPPROV = provider code from NEW PERSON file
+6 ; BGPMUTF = timeframe variable - "C"=current year; "P"=previous year; "B"=baseline year
+7 NEW START,END,BGPNUM,BGPDEN,BGPNUM,AENC,BENC,BGPX,MASTCNT
+8 NEW IEN,INV,VISIT,WTIEN,DATA,VDATE,VALUE,RESULT,FIRST,REF,VIEN,EXCEPT
+9 NEW BGPN1,BGPN3,RETVAL,BGPMUMAM,BGPMAS,AENC,BENC,BGPBIRTH,BGPMAM,BGPMAM2,BGPMAM3,BGPMAM4
+10 NEW BGPENC,BGPBICPT,BGPUICPT,BGPBIICD,BGPUIICD,STRING1,STRING2
+11 NEW BGPDT,BGPDSTR,BGPNSTR
+12 SET (BGPDEN,BGPNUM,RESULT)=0
+13 SET (BGPDSTR,BGPNSTR)=""
+14 SET START=9999999-BGPBDATE
SET END=9999999-BGPEDATE
SET VALUE=0
+15 SET START2Y=9999999-$$FMADD^XLFDT(BGPEDATE,-730)
+16 ;Return value
SET RETVAL=""
SET VIEN=""
+17 SET BGPSEX=$$SEX^AUPNPAT(DFN)
+18 ;Patients must be female
IF BGPSEX="M"
QUIT
+19 ;Pts must be 41-69
+20 ;No need to check further if no age match
+21 IF (BGPAGEE<41)!(BGPAGEE>68)
QUIT
+22 ;find outpatient encounter with provider within 2 years of BGPEDATE
+23 SET FIRST=END-0.1
FOR
SET FIRST=$ORDER(^AUPNVSIT("AA",DFN,FIRST))
IF FIRST=""!($PIECE(FIRST,".",1)>START2Y)!(+VIEN)
QUIT
Begin DoDot:1
+24 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,FIRST,IEN))
IF '+IEN!(VIEN]"")
QUIT
Begin DoDot:2
+25 ;Check provider, Only visits for chosen provider
+26 IF '$$PRV^BGPMUUT1(IEN,BGPPROV)
QUIT
+27 ;Check E&M
+28 SET AENC=$$VSTCPT^BGPMUUT1(DFN,IEN,"BGPMU MAMMOGRAM ENC EM")
+29 SET BENC=$$VSTPOV^BGPMUUT3(DFN,IEN,"BGPMU MAMMOGRAM ENC ICD")
+30 IF (AENC=0)&(BENC=0)
QUIT
+31 SET DATA=$GET(^AUPNVSIT(IEN,0))
+32 SET VDATE=$PIECE($GET(^AUPNVSIT(IEN,0)),U,1)
SET VIEN=IEN
End DoDot:2
End DoDot:1
+33 IF +VIEN
Begin DoDot:1
+34 SET (STRING1,STRING2)=""
+35 KILL BGPX
+36 SET MASTCNT=0
+37 ;Set a new begin date of 2 years prior to the visit
+38 NEW X1,X2,X
SET X1=VDATE
SET X2=-730
DO C^%DTC
SET BGPENC=X
+39 SET BGPDT=$PIECE($PIECE($GET(^AUPNVSIT(VIEN,0)),U,1),".",1)
+40 IF AENC
SET STRING1="ENCC:"_$PIECE(AENC,U,2)
+41 IF BENC
SET STRING1="ENCC:"_$PIECE(BENC,U,2)
+42 SET BGPBIRTH=$PIECE(^DPT(DFN,0),U,3)
+43 IF BGPBIRTH=""
SET BGPBIRTH=BGPENC
+44 ;First, check for bilateral mastectomy
+45 SET BGPBICPT=$$CPT("B")
+46 IF +BGPBICPT
SET VALUE=BGPBICPT
SET RETVAL=1
QUIT
+47 ;Then check for 2 unilateral CPT codes
+48 SET BGPUICPT=$$CPT("U")
+49 IF +BGPUICPT
SET VALUE=BGPUICPT
SET RETVAL=1
QUIT
+50 ;Quit if patient has ICD0 code for bilateral mastectomy on record
+51 SET BGPBIICD=$$LASTPRC^BGPMUUT2(DFN,BGPBIRTH,BGPEDATE,"BGPMU BILAT MASTECTOMY ICD")
+52 IF +BGPBIICD
SET VALUE=BGPBIICD
SET RETVAL=1
QUIT
+53 ;Check for 2 unilateral ICD0 codes
+54 SET BGPUIICD=$$ICD0("U")
+55 IF +BGPUIICD
SET VALUE=BGPUIICD
SET RETVAL=1
QUIT
+56 ;getting here means the patient is in the denominator
+57 SET BGPDSTR=BGPDT
+58 ;Check for mammogram in the last 2 years
+59 SET BGPMAM=$$CPT^BGPMUUT1(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM CPTS")
+60 IF +BGPMAM=1
SET RESULT=BGPMAM
+61 SET BGPMAM2=$$LASTPRC^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM ICD")
+62 IF +BGPMAM2=1
SET RESULT=BGPMAM2
+63 SET BGPMAM3=$$LASTDX^BGPMUUT2(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM DX")
+64 IF +BGPMAM3=1
SET RESULT=BGPMAM3
+65 SET BGPMAM4=$$RAD^BGPMUUT1(DFN,BGPENC,BGPEDATE,"BGPMU MAMMOGRAM CPTS",7)
+66 IF +BGPMAM4
SET RESULT=1_U_BGPMAM4
+67 IF +BGPMAM
SET STRING2="MAMC:"_$PIECE(BGPMAM,U,2)
SET BGPNSTR=$PIECE(BGPMAM,U,2)_";"_$PIECE($PIECE(BGPMAM,U,3),".",1)
+68 IF +BGPMAM2
Begin DoDot:2
+69 IF STRING2=""
SET STRING2="MAMP:"+$PIECE(BGPMAM2,U,2)
SET BGPNSTR=$PIECE(BGPMAM2,U,2)_";"_$PIECE($PIECE(BGPMAM2,U,3),".",1)
+70 IF STRING2'=""
SET STRING2=STRING2_";MAMP:"+$PIECE(BGPMAM2,U,2)
SET BGPNSTR=$PIECE(BGPMAM2,U,2)_";"_$PIECE($PIECE(BGPMAM2,U,3),".",1)
End DoDot:2
+71 IF +BGPMAM3
Begin DoDot:2
+72 IF STRING2=""
SET STRING2="MAMD:"+$PIECE(BGPMAM3,U,2)
SET BGPNSTR=$PIECE(BGPMAM3,U,2)_";"_$PIECE($PIECE(BGPMAM3,U,3),".",1)
+73 IF STRING2'=""
SET STRING2=STRING2_";MAMD:"+$PIECE(BGPMAM3,U,2)
SET BGPNSTR=$PIECE(BGPMAM3,U,2)_";"_$PIECE($PIECE(BGPMAM3,U,3),".",1)
End DoDot:2
+74 IF +BGPMAM4
Begin DoDot:2
+75 IF STRING2=""
SET STRING2="MAMC:"+$PIECE(BGPMAM4,U,2)
SET BGPNSTR=$PIECE(BGPMAM4,U,2)_";"_$PIECE($PIECE(BGPMAM4,U,1),".",1)
+76 IF STRING2'=""
SET STRING2=STRING2_";MAMC:"+$PIECE(BGPMAM4,U,2)
SET BGPNSTR=$PIECE(BGPMAM4,U,2)_";"_$PIECE($PIECE(BGPMAM4,U,1),".",1)
End DoDot:2
+77 DO TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR)
End DoDot:1
+78 QUIT
TOTAL(DFN,VIEN,BGPDSTR,BGPNSTR) ;See where this patient ends up
+1 NEW PTCNT,EXCCT,DENCT,NUMCT,TOTALS
+2 SET TOTALS=$GET(^TMP("BGPMU0031",$JOB,BGPMUTF,"TOT"))
+3 SET DENCT=+$GET(^TMP("BGPMU0031",$JOB,BGPMUTF,"DEN"))
+4 SET NUMCT=+$GET(^TMP("BGPMU0031",$JOB,BGPMUTF,"NUM"))
+5 SET NOTCT=+$GET(^TMP("BGPMU0031",$JOB,BGPMUTF,"NOT"))
+6 SET PTCNT=TOTALS
+7 SET PTCNT=PTCNT+1
+8 ;Do not include those with 2 mastectomies in the denominator
+9 IF +VALUE
QUIT
+10 SET DENCT=DENCT+1
SET ^TMP("BGPMU0031",$JOB,BGPMUTF,"DEN")=DENCT
+11 IF +RESULT
Begin DoDot:1
+12 SET NUMCT=NUMCT+1
SET ^TMP("BGPMU0031",$JOB,BGPMUTF,"NUM")=NUMCT
+13 IF BGPMUTF="C"
SET ^TMP("BGPMU0031",$JOB,"PAT",BGPMUTF,"NUM",PTCNT)=DFN_U_STRING1_U_STRING2_U_$GET(BGPDSTR)_U_$GET(BGPNSTR)
End DoDot:1
+14 IF '$TEST
SET ^TMP("BGPMU0031",$JOB,"PAT",BGPMUTF,"NOT",PTCNT)=DFN_U_STRING1_U_$GET(STRING2)_U_$GET(BGPDSTR)_U_$GET(BGPNSTR)
IF BGPMUTF="C"
SET ^TMP("BGPMU0031",$JOB,"PAT",BGPMUTF,"DEN",PTCNT)=DFN_U_STRING1_U_U_$GET(BGPDSTR)_U_$GET(BGPNSTR)
+15 SET ^TMP("BGPMU0031",$JOB,BGPMUTF,"TOT")=PTCNT
+16 ;Setup iCare array for patient
+17 SET BGPICARE("MU.EP.0031.1",BGPMUTF)=1_U_+RESULT_U_""_U_$GET(BGPDSTR)_";"_$GET(BGPNSTR)
+18 QUIT
CPT(CODE) ;See if the patient has the CPT codes for mastectomy
+1 NEW VAL,TAX,FOUND,VISIT,CPT,MDATE,CPTCODE,MOD1,MOD2
+2 SET VAL=0
+3 ;loop through all cpt codes up to Edate and if any match quit
+4 SET TAX=$ORDER(^ATXAX("B","BGPMU MASTECTOMY CPT",0))
+5 IF TAX
SET FOUND=""
Begin DoDot:1
+6 SET CPT=0
FOR
SET CPT=$ORDER(^AUPNVCPT("AC",DFN,CPT))
IF CPT'=+CPT!(FOUND]"")
QUIT
Begin DoDot:2
+7 SET VISIT=$PIECE($GET(^AUPNVCPT(CPT,0)),U,3)
+8 IF VISIT=""
QUIT
+9 ;date done
SET MDATE=$PIECE($PIECE($GET(^AUPNVSIT(VISIT,0)),U),".")
+10 IF MDATE=""
QUIT
+11 IF MDATE>BGPEDATE
QUIT
+12 SET CPTCODE=$PIECE(^AUPNVCPT(CPT,0),U)
+13 IF '$$ICD^ATXCHK(CPTCODE,TAX,1)
QUIT
+14 IF CODE="U"
SET MASTCNT=MASTCNT+1
+15 SET MOD1=$PIECE(^AUPNVCPT(CPT,0),U,8)
+16 SET MOD2=$PIECE(^AUPNVCPT(CPT,0),U,9)
+17 DO MODIFY(MOD1,MOD2)
End DoDot:2
End DoDot:1
+18 IF 'FOUND
SET FOUND=0
+19 QUIT FOUND
ICD0(CODE) ;See if the patient has the CPT codes for mastectomy
+1 NEW VAL,TAX,FOUND,VISIT,ICD0,MDATE,ICDCODE,MOD1,MOD2,DATA
+2 SET VAL=0
SET DATA=0
+3 ;loop through all ICD0 codes up to Edate and if any match quit
+4 SET TAX=$ORDER(^ATXAX("B","BGPMU UNI MASTECTOMY ICDS",0))
+5 IF TAX
SET FOUND=""
Begin DoDot:1
+6 SET ICD0=0
FOR
SET ICD0=$ORDER(^AUPNVPRC("AC",DFN,ICD0))
IF ICD0'=+ICD0!(FOUND]"")
QUIT
Begin DoDot:2
+7 SET VISIT=$PIECE($GET(^AUPNVPRC(ICD0,0)),U,3)
+8 IF VISIT=""
QUIT
+9 SET MDATE=$PIECE($PIECE($GET(^AUPNVPRC(ICD0,0)),U,6),".")
+10 ;date done
IF MDATE=""
SET MDATE=$PIECE($PIECE($GET(^AUPNVSIT(VISIT,0)),U),".")
+11 IF MDATE=""
QUIT
+12 IF MDATE>BGPEDATE
QUIT
+13 SET ICDCODE=$PIECE(^AUPNVPRC(ICD0,0),U)
+14 IF '$$ICD^ATXCHK(ICDCODE,TAX,0)
QUIT
+15 IF CODE="U"
SET MASTCNT=MASTCNT+1
+16 SET MOD1=$PIECE(^AUPNVPRC(ICD0,0),U,17)
+17 SET MOD2=$PIECE(^AUPNVPRC(ICD0,0),U,18)
+18 DO MODIFY(MOD1,MOD2)
End DoDot:2
End DoDot:1
+19 IF 'FOUND
SET FOUND=0
+20 QUIT FOUND
MODIFY(MOD1,MOD2) ;Check for modifiers
+1 NEW MOD,DATE2
+2 SET MOD=""
+3 IF MOD1
SET MOD=$PIECE($GET(@$$MODGBL@(MOD1,0)),U,1)
+4 IF MOD2
SET MOD=$PIECE($GET(@$$MODGBL@(MOD2,0)),U,1)
+5 IF (MOD1=50)!(MOD2=50)
SET FOUND=1
+6 IF CODE="U"&(MASTCNT=1)
Begin DoDot:1
+7 SET BGPX(MASTCNT)=MDATE_U_MOD
End DoDot:1
+8 IF CODE="U"&(MASTCNT>1)
Begin DoDot:1
+9 IF MDATE'=$PIECE(BGPX(1),U,1)
SET FOUND=1
End DoDot:1
+10 QUIT
MODGBL() QUIT $SELECT($$CSVACT():"^DIC(81.3)",$GET(DUZ("AG"))="I":"^AUTTCMOD",1:"^DIC(81.3)")
CSVACT(RTN) ;EP
+1 QUIT $SELECT(DUZ("AG")'="I":1,$$VERSION^XPDUTL("BCSV")="":0,'$LENGTH($GET(RTN)):1,1:$TEXT(+0^@RTN)'="")
