BQI25PRE.m

BQI25PRE ;GDIT/HS/ALA-Preinstall ; 08 Jan 2015  8:57 AM

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

 ;

 ;

PRE ;EP

 NEW CODE,NM,DA,DIK,IEN,DIU

 S DIK="^BQI(90506.1,"

 F CODE="2007_","2008_","2009_","2010_","2011_","2012_","2013_" D

 . S NM=CODE

 . F  S NM=$O(^BQI(90506.1,"B",NM)) Q:NM=""!($E(NM,1,5)'=CODE)  D

 .. S IEN=$O(^BQI(90506.1,"B",NM,""))

 .. S DA=IEN D ^DIK

 ;

 S DA=0,DIK="^BQI(90506.9,"

 F  S DA=$O(^BQI(90506.9,DA)) Q:'DA  D ^DIK

 ;

 S DA=0,DIK="^BQI(90507.1,"

 F  S DA=$O(^BQI(90507.1,DA)) Q:'DA  D ^DIK

 ;

 S DA=0,DIK="^BQI(90506,"

 F  S DA=$O(^BQI(90506,DA)) Q:'DA  D ^DIK

 ;

 S DA=0,DIC="^BQI(90506.4,"

 F  S DA=$O(^BQI(90506.4,DA)) Q:'DA  D ^DIK

 ;

 S DIU="^BQI(90508,",DIU(0)="" D EN^DIU2

 Q

BQI25PRE  ;GDIT/HS/ALA-Preinstall ; 08 Jan 2015  8:57 AM

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

 +2       ;

 +3       ;

PRE       ;EP

 +1        NEW CODE,NM,DA,DIK,IEN,DIU

 +2        SET DIK="^BQI(90506.1,"

 +3        FOR CODE="2007_","2008_","2009_","2010_","2011_","2012_","2013_"

               Begin DoDot:1

 +4                SET NM=CODE

 +5                FOR 

                       SET NM=$ORDER(^BQI(90506.1,"B",NM))

                       IF NM=""!($EXTRACT(NM,1,5)'=CODE)

                           QUIT 

                       Begin DoDot:2

 +6                        SET IEN=$ORDER(^BQI(90506.1,"B",NM,""))

 +7                        SET DA=IEN

                           DO ^DIK

                       End DoDot:2

               End DoDot:1

 +8       ;

 +9        SET DA=0

           SET DIK="^BQI(90506.9,"

 +10       FOR 

               SET DA=$ORDER(^BQI(90506.9,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +11      ;

 +12       SET DA=0

           SET DIK="^BQI(90507.1,"

 +13       FOR 

               SET DA=$ORDER(^BQI(90507.1,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +14      ;

 +15       SET DA=0

           SET DIK="^BQI(90506,"

 +16       FOR 

               SET DA=$ORDER(^BQI(90506,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +17      ;

 +18       SET DA=0

           SET DIC="^BQI(90506.4,"

 +19       FOR 

               SET DA=$ORDER(^BQI(90506.4,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +20      ;

 +21       SET DIU="^BQI(90508,"

           SET DIU(0)=""

           DO EN^DIU2

 +22       QUIT