BDMSMU2.m

BDMSMU2 ; IHS/CMI/LAB - utilities for hmr ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,9**;JUN 14, 2007;Build 78

 ;

 ;

 ;cmi/anch/maw 8/28/2007 code set versioning in CPT

 ;

WH(P,BDATE,EDATE,T,F) ;EP

 I '$G(P) Q ""

 I '$G(T) Q ""

 I '$G(F) S F=1

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 ;go through procedures in a date range for this patient, check proc type

 NEW D,X,Y,G,V

 S (G,V)=0 F  S V=$O(^BWPCD("C",P,V)) Q:V=""!(G)  D

 .Q:'$D(^BWPCD(V,0))

 .I $P(^BWPCD(V,0),U,4)'=T Q

 .S D=$P(^BWPCD(V,0),U,12)

 .Q:D<BDATE

 .Q:D>EDATE

 .S G=V

 .Q

 I 'G Q ""

 I F=1 Q $S(G:1,1:"")

 I F=2 Q G

 I F=3 S D=$P(^BWPCD(G,0),U,12) Q D

 I F=4 S D=$P(^BWPCD(G,0),U,12) Q $$FMTE^XLFDT(D)

 Q ""

 ;

CPT(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT

 I '$G(P) Q ""

 I '$G(T) Q ""

 I '$G(F) S F=1

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 ;go through visits in a date range for this patient, check cpts

 NEW D,BD,ED,X,Y,D,G,V

 S ED=9999999-EDATE,BD=9999999-BDATE,G=0

 F  S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  D

 .S V=0 F  S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G)  D

 ..Q:'$D(^AUPNVSIT(V,0))

 ..Q:'$D(^AUPNVCPT("AD",V))

 ..S X=0 F  S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G)  D

 ...I $$ICD^BDMUTL($P(^AUPNVCPT(X,0),U),T,1) S G=X

 ...Q

 ..Q

 .Q

 I 'G Q ""

 I F=1 Q $S(G:1,1:"")

 I F=2 Q G

 I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")

 I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))

 ;cmi/anch/maw 8/28/2007 mods for code set versioning

 N BDMSVDT

 ;I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^ICPT($P(^AUPNVCPT(G,0),U),0),U)

 I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V S BDMSVDT=$P(+V,".") Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P($$CPT^ICPTCOD($P(^AUPNVCPT(G,0),U),BDMSVDT),U,2)

 ;cmi/anch/maw 8/28/2007 end of mods

 Q ""

LASTDX(P,T,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V POV

 NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 S (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)  ;if no date then set to DOB

 I $G(EDATE)="" S EDATE=DT  ;if no end date then set to today

 S BDMTX5=$O(^ATXAX("B",T,0))  ;get taxonomy ien

 I BDMTX5="" Q ""  ;not a valid taxonomy

 S BDMDX4=""  ;return value

 S BDMDXBD=9999999-BDATE,BDMDXED=9999999-EDATE  ;get inverse date and begin at edate-1 and end when greater than begin date

 S BDMDX1=BDMDXED-1 F  S BDMDX1=$O(^AUPNVPOV("AA",P,BDMDX1)) Q:BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")  D

 .S BDMDX2=0 F  S BDMDX2=$O(^AUPNVPOV("AA",P,BDMDX1,BDMDX2)) Q:BDMDX2'=+BDMDX2!(BDMDX4]"")  D

 ..S BDMDX3=$P($G(^AUPNVPOV(BDMDX2,0)),U)

 ..Q:BDMDX3=""  ;bad xref

 ..Q:'$D(^ICD9(BDMDX3))

 ..Q:'$$ICD^BDMUTL(BDMDX3,BDMTX5,9)

 ..S BDMDX4=1_"^"_$P($$ICDDX^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 ..Q

 .Q

 Q BDMDX4

LASTDXI(P,T,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V POV

 NEW BDMDX1,BDMDX2,BDMDX3,BDMDX5,BDMTX5,BDMDXBD,BDMDXED

 S (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)  ;if no date then set to DOB

 I $G(EDATE)="" S EDATE=DT  ;if no end date then set to today

 S BDMTX5=+$$CODEN^BDMUTL(T,80)  ;cmi/maw 5/13/2014 patch 8 ICD-10

 ;S BDMTX5=+$$CODEN^ICDCODE(T,80)

 I BDMTX5=""!(BDMTX5=-1) Q ""  ;not a CODE

 S BDMDX4=""  ;return value

 S BDMDXBD=9999999-BDATE,BDMDXED=9999999-EDATE  ;get inverse date and begin at edate-1 and end when greater than begin date

 S BDMDX1=BDMDXED-1 F  S BDMDX1=$O(^AUPNVPOV("AA",P,BDMDX1)) Q:BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")  D

 .S BDMDX2=0 F  S BDMDX2=$O(^AUPNVPOV("AA",P,BDMDX1,BDMDX2)) Q:BDMDX2'=+BDMDX2!(BDMDX4]"")  D

 ..S BDMDX3=$P($G(^AUPNVPOV(BDMDX2,0)),U)

 ..Q:BDMDX3=""  ;bad xref

 ..Q:BDMDX3'=BDMTX5

 ..S BDMDX4=1_"^"_$P($$ICDDX^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 ..Q

 .Q

 Q BDMDX4

LASTPRC(P,T,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V PROC

 NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 S (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)  ;if no date then set to DOB

 I $G(EDATE)="" S EDATE=DT  ;if no end date then set to today

 S BDMTX5=$O(^ATXAX("B",T,0))  ;get taxonomy ien

 I BDMTX5="" Q ""  ;not a valid taxonomy

 S BDMDX4=""  ;return value

 S BDMDXBD=9999999-BDATE,BDMDXED=9999999-EDATE  ;get inverse date and begin at edate-1 and end when greater than begin date

 S BDMDX1=BDMDXED-1 F  S BDMDX1=$O(^AUPNVPRC("AA",P,BDMDX1)) Q:BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")  D

 .S BDMDX2=0 F  S BDMDX2=$O(^AUPNVPRC("AA",P,BDMDX1,BDMDX2)) Q:BDMDX2'=+BDMDX2!(BDMDX4]"")  D

 ..S BDMDX3=$P($G(^AUPNVPRC(BDMDX2,0)),U)

 ..Q:BDMDX3=""  ;bad xref

 ..Q:'$$ICD^BDMUTL(BDMDX3,BDMTX5,0)

 ..S BDMDX4=1_"^"_$P($$ICDOP^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 ..Q

 .Q

 Q BDMDX4

 ;

LASTPRCI(P,T,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V PROC

 NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 S (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)  ;if no date then set to DOB

 I $G(EDATE)="" S EDATE=DT  ;if no end date then set to today

 S BDMTX5=+$$CODEN^BDMUTL(T,80.1)  ;cmi/maw 5/13/2014 patch 8 ICD-10

 ;S BDMTX5=+$$CODEN^ICDCODE(T,80.1)

 I BDMTX5=""!(BDMTX5=-1) Q ""  ;not a valid PROC

 S BDMDX4=""  ;return value

 S BDMDXBD=9999999-BDATE,BDMDXED=9999999-EDATE  ;get inverse date and begin at edate-1 and end when greater than begin date

 S BDMDX1=BDMDXED-1 F  S BDMDX1=$O(^AUPNVPRC("AA",P,BDMDX1)) Q:BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")  D

 .S BDMDX2=0 F  S BDMDX2=$O(^AUPNVPRC("AA",P,BDMDX1,BDMDX2)) Q:BDMDX2'=+BDMDX2!(BDMDX4]"")  D

 ..S BDMDX3=$P($G(^AUPNVPRC(BDMDX2,0)),U)

 ..Q:BDMDX3=""  ;bad xref

 ..Q:BDMTX5'=BDMDX3

 ..S BDMDX4=1_"^"_$P($$ICDOP^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 ..Q

 .Q

 Q BDMDX4

CPTI(P,BDATE,EDATE,CPTI) ;EP - did patient have this cpt (ien) in date range

 I '$G(P) Q ""

 I $G(CPTI)="" Q ""

 I $G(BDATE)="" Q ""

 I $G(EDATE)="" Q ""

 I '$D(^ICPT(CPTI)) Q ""  ;not a valid cpt ien

 I '$D(^AUPNVCPT("AA",P)) Q ""  ;no cpts for this patient

 NEW D,BD,ED,X,Y,D,G,V

 S ED=9999999-EDATE-1,BD=9999999-BDATE,G=""

 F  S ED=$O(^AUPNVCPT("AA",P,CPTI,ED)) Q:ED=""!($P(ED,".")>BD)!(G)  S G="1"_"^"_(9999999-ED)

 Q G

 ;

LASTCPTI(P,T,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 ;RETURN BDMDX4=1 or 0^CPT code^date found^IEN OF CPT CODE^IEN OF V CPT

 NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 S (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)  ;if no date then set to DOB

 I $G(EDATE)="" S EDATE=DT  ;if no end date then set to today

 S BDMTX5=+$$CODEN^ICPTCOD(T)

 I BDMTX5="" Q ""  ;not a valid CPT

 S BDMDX4=""  ;return value

 S BDMDXBD=9999999-BDATE,BDMDXED=9999999-EDATE  ;get inverse date and begin at edate-1 and end when greater than begin date

 S BDMDX1=BDMDXED-1 F  S BDMDX1=$O(^AUPNVCPT("AA",P,BDMTX5,BDMDX1)) Q:BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")  D

 .S BDMDX2=0 F  S BDMDX2=$O(^AUPNVCPT("AA",P,BDMTX5,BDMDX1,BDMDX2)) Q:BDMDX2'=+BDMDX2!(BDMDX4]"")  D

 ..S BDMDX3=$P($G(^AUPNVCPT(BDMDX2,0)),U)

 ..Q:BDMDX3=""  ;bad xref

 ..Q:BDMTX5'=BDMDX3

 ..S BDMDX4=1_"^"_$P($$CPT^ICPTCOD(BDMDX3),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 ..Q

 .Q

 Q BDMDX4

CPTREFT(P,BDATE,EDATE,T) ;EP - return ien of CPT entry if patient had this CPT

 I '$G(P) Q ""

 I '$G(T) Q ""

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 NEW G,X,Y,Z,I

 S G=""

 S I=0 F  S I=$O(^AUPNPREF("AA",P,81,I)) Q:I=""!($P(G,U)]"")  D

 .S X=0 F  S X=$O(^AUPNPREF("AA",P,81,I,X)) Q:X'=+X!($P(G,U)]"")  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,81,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<BDATE&(D'>EDATE) D

 ..Q:'$$ICD^BDMUTL(I,T,1)

 ..S G=$$TYPEREF^BDMSMU(Y)_$E($$VAL^XBDIQ1(81,I,$$FFD^BDMSMU(81)),1,(44-$L($$TYPEREF^BDMSMU(Y))))_"^on "_$$FMTE^XLFDT(D)_"^"_D

 .Q

 Q G

RADREF(P,BDATE,EDATE,T) ;EP - return ien of CPT entry if patient had this CPT

 I '$G(P) Q ""

 I '$G(T) Q ""

 I $G(EDATE)="" Q ""

 I $G(BDATE)="" S BDATE=$$FMADD^XLFDT(EDATE,-365)

 NEW G,X,Y,Z,I,C

 S G=""

 S I=0 F  S I=$O(^AUPNPREF("AA",P,71,I)) Q:I=""!($P(G,U)]"")  D

 .S X=0 F  S X=$O(^AUPNPREF("AA",P,71,I,X)) Q:X'=+X!($P(G,U)]"")  S Y=0 F  S Y=$O(^AUPNPREF("AA",P,71,I,X,Y)) Q:Y'=+Y  S D=$P(^AUPNPREF(Y,0),U,3) I D'<BDATE&(D'>EDATE) D

 ..S C=$P($G(^RAMIS(71,I,0)),U,9) Q:C=""

 ..Q:'$$ICD^BDMUTL(C,T,1)

 ..S N=$P(^AUPNPREF(Y,0),U,7)

 ..S G=$$TYPEREF^BDMSMU(Y)_$E($$VAL^XBDIQ1(81,C,$$FFD^BDMSMU(81)),1,(44-$L($$TYPEREF^BDMSMU(Y))))_"^on "_$$FMTE^XLFDT(D)_"^"_D

 .Q

 Q G

 ;

LASTTD(P) ;EP

 I '$G(P) Q ""

 Q $$LASTTD^APCLAPI4(P)

BDMSMU2   ; IHS/CMI/LAB - utilities for hmr ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,9**;JUN 14, 2007;Build 78

 +2       ;

 +3       ;

 +4       ;cmi/anch/maw 8/28/2007 code set versioning in CPT

 +5       ;

WH(P,BDATE,EDATE,T,F) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$GET(T)

               QUIT ""

 +3        IF '$GET(F)

               SET F=1

 +4        IF $GET(EDATE)=""

               QUIT ""

 +5        IF $GET(BDATE)=""

               SET BDATE=$$FMADD^XLFDT(EDATE,-365)

 +6       ;go through procedures in a date range for this patient, check proc type

 +7        NEW D,X,Y,G,V

 +8        SET (G,V)=0

           FOR 

               SET V=$ORDER(^BWPCD("C",P,V))

               IF V=""!(G)

                   QUIT 

               Begin DoDot:1

 +9                IF '$DATA(^BWPCD(V,0))

                       QUIT 

 +10               IF $PIECE(^BWPCD(V,0),U,4)'=T

                       QUIT 

 +11               SET D=$PIECE(^BWPCD(V,0),U,12)

 +12               IF D<BDATE

                       QUIT 

 +13               IF D>EDATE

                       QUIT 

 +14               SET G=V

 +15               QUIT 

               End DoDot:1

 +16       IF 'G

               QUIT ""

 +17       IF F=1

               QUIT $SELECT(G:1,1:"")

 +18       IF F=2

               QUIT G

 +19       IF F=3

               SET D=$PIECE(^BWPCD(G,0),U,12)

               QUIT D

 +20       IF F=4

               SET D=$PIECE(^BWPCD(G,0),U,12)

               QUIT $$FMTE^XLFDT(D)

 +21       QUIT ""

 +22      ;

CPT(P,BDATE,EDATE,T,F) ;EP - return ien of CPT entry if patient had this CPT

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$GET(T)

               QUIT ""

 +3        IF '$GET(F)

               SET F=1

 +4        IF $GET(EDATE)=""

               QUIT ""

 +5        IF $GET(BDATE)=""

               SET BDATE=$$FMADD^XLFDT(EDATE,-365)

 +6       ;go through visits in a date range for this patient, check cpts

 +7        NEW D,BD,ED,X,Y,D,G,V

 +8        SET ED=9999999-EDATE

           SET BD=9999999-BDATE

           SET G=0

 +9        FOR 

               SET ED=$ORDER(^AUPNVSIT("AA",P,ED))

               IF ED=""!($PIECE(ED,".")>BD)!(G)

                   QUIT 

               Begin DoDot:1

 +10               SET V=0

                   FOR 

                       SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))

                       IF V'=+V!(G)

                           QUIT 

                       Begin DoDot:2

 +11                       IF '$DATA(^AUPNVSIT(V,0))

                               QUIT 

 +12                       IF '$DATA(^AUPNVCPT("AD",V))

                               QUIT 

 +13                       SET X=0

                           FOR 

                               SET X=$ORDER(^AUPNVCPT("AD",V,X))

                               IF X'=+X!(G)

                                   QUIT 

                               Begin DoDot:3

 +14                               IF $$ICD^BDMUTL($PIECE(^AUPNVCPT(X,0),U),T,1)

                                       SET G=X

 +15                               QUIT 

                               End DoDot:3

 +16                       QUIT 

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18       IF 'G

               QUIT ""

 +19       IF F=1

               QUIT $SELECT(G:1,1:"")

 +20       IF F=2

               QUIT G

 +21       IF F=3

               SET V=$PIECE(^AUPNVCPT(G,0),U,3)

               IF V

                   QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")

 +22       IF F=4

               SET V=$PIECE(^AUPNVCPT(G,0),U,3)

               IF V

                   QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))

 +23      ;cmi/anch/maw 8/28/2007 mods for code set versioning

 +24       NEW BDMSVDT

 +25      ;I F=5 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")_"^"_$P(^ICPT($P(^AUPNVCPT(G,0),U),0),U)

 +26       IF F=5

               SET V=$PIECE(^AUPNVCPT(G,0),U,3)

               IF V

                   SET BDMSVDT=$PIECE(+V,".")

                   QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")_"^"_$PIECE($$CPT^ICPTCOD($PIECE(^AUPNVCPT(G,0),U),BDMSVDT),U,2)

 +27      ;cmi/anch/maw 8/28/2007 end of mods

 +28       QUIT ""

LASTDX(P,T,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2       ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V POV

 +3        NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 +4        SET (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 +5       ;if no date then set to DOB

           IF $GET(BDATE)=""

               SET BDATE=$PIECE(^DPT(P,0),U,3)

 +6       ;if no end date then set to today

           IF $GET(EDATE)=""

               SET EDATE=DT

 +7       ;get taxonomy ien

           SET BDMTX5=$ORDER(^ATXAX("B",T,0))

 +8       ;not a valid taxonomy

           IF BDMTX5=""

               QUIT ""

 +9       ;return value

           SET BDMDX4=""

 +10      ;get inverse date and begin at edate-1 and end when greater than begin date

           SET BDMDXBD=9999999-BDATE

           SET BDMDXED=9999999-EDATE

 +11       SET BDMDX1=BDMDXED-1

           FOR 

               SET BDMDX1=$ORDER(^AUPNVPOV("AA",P,BDMDX1))

               IF BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")

                   QUIT 

               Begin DoDot:1

 +12               SET BDMDX2=0

                   FOR 

                       SET BDMDX2=$ORDER(^AUPNVPOV("AA",P,BDMDX1,BDMDX2))

                       IF BDMDX2'=+BDMDX2!(BDMDX4]"")

                           QUIT 

                       Begin DoDot:2

 +13                       SET BDMDX3=$PIECE($GET(^AUPNVPOV(BDMDX2,0)),U)

 +14      ;bad xref

                           IF BDMDX3=""

                               QUIT 

 +15                       IF '$DATA(^ICD9(BDMDX3))

                               QUIT 

 +16                       IF '$$ICD^BDMUTL(BDMDX3,BDMTX5,9)

                               QUIT 

 +17                       SET BDMDX4=1_"^"_$PIECE($$ICDDX^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 +18                       QUIT 

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       QUIT BDMDX4

LASTDXI(P,T,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2       ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V POV

 +3        NEW BDMDX1,BDMDX2,BDMDX3,BDMDX5,BDMTX5,BDMDXBD,BDMDXED

 +4        SET (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 +5       ;if no date then set to DOB

           IF $GET(BDATE)=""

               SET BDATE=$PIECE(^DPT(P,0),U,3)

 +6       ;if no end date then set to today

           IF $GET(EDATE)=""

               SET EDATE=DT

 +7       ;cmi/maw 5/13/2014 patch 8 ICD-10

           SET BDMTX5=+$$CODEN^BDMUTL(T,80)

 +8       ;S BDMTX5=+$$CODEN^ICDCODE(T,80)

 +9       ;not a CODE

           IF BDMTX5=""!(BDMTX5=-1)

               QUIT ""

 +10      ;return value

           SET BDMDX4=""

 +11      ;get inverse date and begin at edate-1 and end when greater than begin date

           SET BDMDXBD=9999999-BDATE

           SET BDMDXED=9999999-EDATE

 +12       SET BDMDX1=BDMDXED-1

           FOR 

               SET BDMDX1=$ORDER(^AUPNVPOV("AA",P,BDMDX1))

               IF BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")

                   QUIT 

               Begin DoDot:1

 +13               SET BDMDX2=0

                   FOR 

                       SET BDMDX2=$ORDER(^AUPNVPOV("AA",P,BDMDX1,BDMDX2))

                       IF BDMDX2'=+BDMDX2!(BDMDX4]"")

                           QUIT 

                       Begin DoDot:2

 +14                       SET BDMDX3=$PIECE($GET(^AUPNVPOV(BDMDX2,0)),U)

 +15      ;bad xref

                           IF BDMDX3=""

                               QUIT 

 +16                       IF BDMDX3'=BDMTX5

                               QUIT 

 +17                       SET BDMDX4=1_"^"_$PIECE($$ICDDX^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 +18                       QUIT 

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       QUIT BDMDX4

LASTPRC(P,T,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2       ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V PROC

 +3        NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 +4        SET (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 +5       ;if no date then set to DOB

           IF $GET(BDATE)=""

               SET BDATE=$PIECE(^DPT(P,0),U,3)

 +6       ;if no end date then set to today

           IF $GET(EDATE)=""

               SET EDATE=DT

 +7       ;get taxonomy ien

           SET BDMTX5=$ORDER(^ATXAX("B",T,0))

 +8       ;not a valid taxonomy

           IF BDMTX5=""

               QUIT ""

 +9       ;return value

           SET BDMDX4=""

 +10      ;get inverse date and begin at edate-1 and end when greater than begin date

           SET BDMDXBD=9999999-BDATE

           SET BDMDXED=9999999-EDATE

 +11       SET BDMDX1=BDMDXED-1

           FOR 

               SET BDMDX1=$ORDER(^AUPNVPRC("AA",P,BDMDX1))

               IF BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")

                   QUIT 

               Begin DoDot:1

 +12               SET BDMDX2=0

                   FOR 

                       SET BDMDX2=$ORDER(^AUPNVPRC("AA",P,BDMDX1,BDMDX2))

                       IF BDMDX2'=+BDMDX2!(BDMDX4]"")

                           QUIT 

                       Begin DoDot:2

 +13                       SET BDMDX3=$PIECE($GET(^AUPNVPRC(BDMDX2,0)),U)

 +14      ;bad xref

                           IF BDMDX3=""

                               QUIT 

 +15                       IF '$$ICD^BDMUTL(BDMDX3,BDMTX5,0)

                               QUIT 

 +16                       SET BDMDX4=1_"^"_$PIECE($$ICDOP^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       QUIT BDMDX4

 +20      ;

LASTPRCI(P,T,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2       ;RETURN BDMDX4=1 or 0^dx code^date found^IEN OF ICD CODE^IEN OF V PROC

 +3        NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 +4        SET (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 +5       ;if no date then set to DOB

           IF $GET(BDATE)=""

               SET BDATE=$PIECE(^DPT(P,0),U,3)

 +6       ;if no end date then set to today

           IF $GET(EDATE)=""

               SET EDATE=DT

 +7       ;cmi/maw 5/13/2014 patch 8 ICD-10

           SET BDMTX5=+$$CODEN^BDMUTL(T,80.1)

 +8       ;S BDMTX5=+$$CODEN^ICDCODE(T,80.1)

 +9       ;not a valid PROC

           IF BDMTX5=""!(BDMTX5=-1)

               QUIT ""

 +10      ;return value

           SET BDMDX4=""

 +11      ;get inverse date and begin at edate-1 and end when greater than begin date

           SET BDMDXBD=9999999-BDATE

           SET BDMDXED=9999999-EDATE

 +12       SET BDMDX1=BDMDXED-1

           FOR 

               SET BDMDX1=$ORDER(^AUPNVPRC("AA",P,BDMDX1))

               IF BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")

                   QUIT 

               Begin DoDot:1

 +13               SET BDMDX2=0

                   FOR 

                       SET BDMDX2=$ORDER(^AUPNVPRC("AA",P,BDMDX1,BDMDX2))

                       IF BDMDX2'=+BDMDX2!(BDMDX4]"")

                           QUIT 

                       Begin DoDot:2

 +14                       SET BDMDX3=$PIECE($GET(^AUPNVPRC(BDMDX2,0)),U)

 +15      ;bad xref

                           IF BDMDX3=""

                               QUIT 

 +16                       IF BDMTX5'=BDMDX3

                               QUIT 

 +17                       SET BDMDX4=1_"^"_$PIECE($$ICDOP^BDMUTL(BDMDX3,,,"I"),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 +18                       QUIT 

                       End DoDot:2

 +19               QUIT 

               End DoDot:1

 +20       QUIT BDMDX4

CPTI(P,BDATE,EDATE,CPTI) ;EP - did patient have this cpt (ien) in date range

 +1        IF '$GET(P)

               QUIT ""

 +2        IF $GET(CPTI)=""

               QUIT ""

 +3        IF $GET(BDATE)=""

               QUIT ""

 +4        IF $GET(EDATE)=""

               QUIT ""

 +5       ;not a valid cpt ien

           IF '$DATA(^ICPT(CPTI))

               QUIT ""

 +6       ;no cpts for this patient

           IF '$DATA(^AUPNVCPT("AA",P))

               QUIT ""

 +7        NEW D,BD,ED,X,Y,D,G,V

 +8        SET ED=9999999-EDATE-1

           SET BD=9999999-BDATE

           SET G=""

 +9        FOR 

               SET ED=$ORDER(^AUPNVCPT("AA",P,CPTI,ED))

               IF ED=""!($PIECE(ED,".")>BD)!(G)

                   QUIT 

               SET G="1"_"^"_(9999999-ED)

 +10       QUIT G

 +11      ;

LASTCPTI(P,T,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2       ;RETURN BDMDX4=1 or 0^CPT code^date found^IEN OF CPT CODE^IEN OF V CPT

 +3        NEW BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5,BDMDXBD,BDMDXED

 +4        SET (BDMDX1,BDMDX2,BDMDX3,BDMDX4,BDMTX5)=""

 +5       ;if no date then set to DOB

           IF $GET(BDATE)=""

               SET BDATE=$PIECE(^DPT(P,0),U,3)

 +6       ;if no end date then set to today

           IF $GET(EDATE)=""

               SET EDATE=DT

 +7        SET BDMTX5=+$$CODEN^ICPTCOD(T)

 +8       ;not a valid CPT

           IF BDMTX5=""

               QUIT ""

 +9       ;return value

           SET BDMDX4=""

 +10      ;get inverse date and begin at edate-1 and end when greater than begin date

           SET BDMDXBD=9999999-BDATE

           SET BDMDXED=9999999-EDATE

 +11       SET BDMDX1=BDMDXED-1

           FOR 

               SET BDMDX1=$ORDER(^AUPNVCPT("AA",P,BDMTX5,BDMDX1))

               IF BDMDX1=""!(BDMDX1>BDMDXBD)!(BDMDX4]"")

                   QUIT 

               Begin DoDot:1

 +12               SET BDMDX2=0

                   FOR 

                       SET BDMDX2=$ORDER(^AUPNVCPT("AA",P,BDMTX5,BDMDX1,BDMDX2))

                       IF BDMDX2'=+BDMDX2!(BDMDX4]"")

                           QUIT 

                       Begin DoDot:2

 +13                       SET BDMDX3=$PIECE($GET(^AUPNVCPT(BDMDX2,0)),U)

 +14      ;bad xref

                           IF BDMDX3=""

                               QUIT 

 +15                       IF BDMTX5'=BDMDX3

                               QUIT 

 +16                       SET BDMDX4=1_"^"_$PIECE($$CPT^ICPTCOD(BDMDX3),U,2)_"^"_(9999999-BDMDX1)_"^"_BDMDX3_"^"_BDMDX2

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1