BQITDBMI.m

BQITDBMI ;GDIT/HS/ALA-BMI ; 04 Feb 2014  9:34 AM

 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 ;

 ;

ABMI ;EP

FD ;  Find data

 W !,$$NOW^XLFDT()

 S BDFN=""

 ;F  S BDFN=$O(^AUPNVMSR("AA",BDFN)) Q:BDFN=""  D

 ;. S BMID=$$PBMI^APCLV(BDFN,DT)

 ;. I $P(BMID,"^",1)'="" S ^ARLIS(BDFN,"BMID")=BMID

 ;Q

 S TMFRAME="T-60M"

 S BBMI=$$FIND1^DIC(9999999.07,,"X","BMI")

 S BDATE=(9999999-DT)

 S EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))

 S BDATE19=$$DATE^BQIUL1("T-12M")

 S BDATE50=$$DATE^BQIUL1("T-24M")

 ;

 F  S BDFN=$O(^AUPNVMSR("AA",BDFN)) Q:BDFN=""  D

 . S DATE=BDATE-.01

 . S CAGE=$$AGE^BQIAGE(BDFN) ; patient's current age

 . F  S DATE=$O(^AUPNVMSR("AA",BDFN,BBMI,DATE)) Q:DATE=""!(DATE>EDATE)  D  Q:QFL

 .. S MDATE=9999999-DATE

 .. I CAGE<19,MDATE<BDATE19 Q

 .. I CAGE>49,MDATE<BDATE50 Q

 .. S BMID=$$PBMI^APCLV(BDFN,DT)

 .. I $P(BMID,"^",1)'="" S QFL=1,^ARLIS(BDFN,"AMID")=BMID

 W !,$$NOW^XLFDT()

 Q

BQITDBMI  ;GDIT/HS/ALA-BMI ; 04 Feb 2014  9:34 AM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27

 +2       ;

 +3       ;

ABMI      ;EP

FD        ;  Find data

 +1        WRITE !,$$NOW^XLFDT()

 +2        SET BDFN=""

 +3       ;F  S BDFN=$O(^AUPNVMSR("AA",BDFN)) Q:BDFN=""  D

 +4       ;. S BMID=$$PBMI^APCLV(BDFN,DT)

 +5       ;. I $P(BMID,"^",1)'="" S ^ARLIS(BDFN,"BMID")=BMID

 +6       ;Q

 +7        SET TMFRAME="T-60M"

 +8        SET BBMI=$$FIND1^DIC(9999999.07,,"X","BMI")

 +9        SET BDATE=(9999999-DT)

 +10       SET EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))

 +11       SET BDATE19=$$DATE^BQIUL1("T-12M")

 +12       SET BDATE50=$$DATE^BQIUL1("T-24M")

 +13      ;

 +14       FOR 

               SET BDFN=$ORDER(^AUPNVMSR("AA",BDFN))

               IF BDFN=""

                   QUIT 

               Begin DoDot:1

 +15               SET DATE=BDATE-.01

 +16      ; patient's current age

                   SET CAGE=$$AGE^BQIAGE(BDFN)

 +17               FOR 

                       SET DATE=$ORDER(^AUPNVMSR("AA",BDFN,BBMI,DATE))

                       IF DATE=""!(DATE>EDATE)

                           QUIT 

                       Begin DoDot:2

 +18                       SET MDATE=9999999-DATE

 +19                       IF CAGE<19

                               IF MDATE<BDATE19

                                   QUIT 

 +20                       IF CAGE>49

                               IF MDATE<BDATE50

                                   QUIT 

 +21                       SET BMID=$$PBMI^APCLV(BDFN,DT)

 +22                       IF $PIECE(BMID,"^",1)'=""

                               SET QFL=1

                               SET ^ARLIS(BDFN,"AMID")=BMID

                       End DoDot:2

                       IF QFL

                           QUIT 

               End DoDot:1

 +23       WRITE !,$$NOW^XLFDT()

 +24       QUIT