BDMS9B6.m

BDMS9B6 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,8**;JUN 14, 2007;Build 53

 ;

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

 ;

TOBACCO ;EP

 ;

CHEST(P) ;EP - get date of last chest xray from V RAD or V CPT

 ;FIX ALL RAD LOOKUPS TO LOOP THROUGH GLOBAL

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

 NEW X,Y,Z,G,LCHEST,T,D

 S LCHEST=""

 S (X,Y,V)=0 F  S X=$O(^AUPNVRAD("AC",P,X)) Q:X'=+X  D

 .S V=$P(^AUPNVRAD(X,0),U,3),V=$P($P($G(^AUPNVSIT(V,0)),U),".")

 .S Y=$P(^AUPNVRAD(X,0),U),Y=$P($G(^RAMIS(71,Y,0)),U,9)

 .I Y>71009&(Y<71036),V>LCHEST S LCHEST=V Q

 S T=71009 F  S T=$O(^ICPT("B",T)) Q:T>71035  S X=0 F  S X=$O(^ICPT("B",T,X)) Q:X'=+X  D

 .S D=$O(^AUPNVCPT("AA",P,X,0)) I D S D=9999999-D

 .I D,D>LCHEST S LCHEST=D

 K BDMY S %=P_"^LAST PROCEDURE 87.44",E=$$START1^APCLDF(%,"BDMY(")

 I $D(BDMY(1)),$P(BDMY(1),U)>LCHEST S LCHEST=$P(BDMY(1),U)

 K BDMY S %=P_"^LAST PROCEDURE 87.39",E=$$START1^APCLDF(%,"BDMY(")

 I $D(BDMY(1)),$P(BDMY(1),U)>LCHEST S LCHEST=$P(BDMY(1),U)

 Q $S(LCHEST]"":$$FMTE^XLFDT(LCHEST),1:"")

BDMS9B6   ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,8**;JUN 14, 2007;Build 53

 +2       ;

 +3       ;cmi/anch/maw 8/28/2007 code set versioning in TOBACCO1

 +4       ;

TOBACCO   ;EP

 +1       ;

CHEST(P)  ;EP - get date of last chest xray from V RAD or V CPT

 +1       ;FIX ALL RAD LOOKUPS TO LOOP THROUGH GLOBAL

 +2        IF $GET(P)=""

               QUIT ""

 +3        NEW X,Y,Z,G,LCHEST,T,D

 +4        SET LCHEST=""

 +5        SET (X,Y,V)=0

           FOR 

               SET X=$ORDER(^AUPNVRAD("AC",P,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                SET V=$PIECE(^AUPNVRAD(X,0),U,3)

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

 +7                SET Y=$PIECE(^AUPNVRAD(X,0),U)

                   SET Y=$PIECE($GET(^RAMIS(71,Y,0)),U,9)

 +8                IF Y>71009&(Y<71036)

                       IF V>LCHEST

                           SET LCHEST=V

                           QUIT 

               End DoDot:1

 +9        SET T=71009

           FOR 

               SET T=$ORDER(^ICPT("B",T))

               IF T>71035

                   QUIT 

               SET X=0

               FOR 

                   SET X=$ORDER(^ICPT("B",T,X))

                   IF X'=+X

                       QUIT 

                   Begin DoDot:1

 +10                   SET D=$ORDER(^AUPNVCPT("AA",P,X,0))

                       IF D

                           SET D=9999999-D

 +11                   IF D

                           IF D>LCHEST

                               SET LCHEST=D

                   End DoDot:1

 +12       KILL BDMY

           SET %=P_"^LAST PROCEDURE 87.44"

           SET E=$$START1^APCLDF(%,"BDMY(")

 +13       IF $DATA(BDMY(1))

               IF $PIECE(BDMY(1),U)>LCHEST

                   SET LCHEST=$PIECE(BDMY(1),U)

 +14       KILL BDMY

           SET %=P_"^LAST PROCEDURE 87.39"

           SET E=$$START1^APCLDF(%,"BDMY(")

 +15       IF $DATA(BDMY(1))

               IF $PIECE(BDMY(1),U)>LCHEST

                   SET LCHEST=$PIECE(BDMY(1),U)

 +16       QUIT $SELECT(LCHEST]"":$$FMTE^XLFDT(LCHEST),1:"")