Routine: BNIPOST

BNIPOST ; IHS/CMI/LAB - Routine to create bulletin ;

 ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

;;

 ; The following line prevents the "Disable Options..." and "Move

 ; Routines..." questions from being asked during the install.

 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0

PRE ;EP

 F DA=1:1:500 S DIK="^BNIGRI(" D ^DIK

POST ;EP

 S DIK(1)=".01^AE",DIK="^BNIREC(" D ENALL^DIK

 K DIK

 ;move ado schemas to bmx ado schema

 S BNIX=0 F  S BNIX=$O(^BNIADO(BNIX)) Q:BNIX'=+BNIX  D

 .S BNIN=$P(^BNIADO(BNIX,0),U)

 .Q:$D(^BMXADO("B",BNIN))  ;already in file

 .S G=0,X=0 F  S X=$O(^BMXADO(X)) Q:X'=+X!(G)  I $P(^BMXADO(X,0),U)=BNIN S G=1

 .Q:G

 .S X=BNIN,DIC="^BMXADO(",DIADD=1,DLAYGO=90093.99,DIC(0)="AEMQL" K DO,D0,DD D FILE^DICN

 .I Y=-1 W !!,"Failure to add BMX ADO Schema ",BNIN K DIADD,DLAYGO,DIC,DA Q

 .S BNIDA=+Y

 .K DIADD,DLAYGO,DIC,DA D ^XBFMK

 .M ^BMXADO(BNIDA)=^BNIADO(BNIX)

 .S DA=BNIDA,DIK="^BMXADO(" D IX1^DIK K DA,DIK

BNIPOST   ; IHS/CMI/LAB - Routine to create bulletin ;

 +1       ;;1.0;BNI CPHD ACTIVITY DATASYSTEM;;DEC 20, 2006

 +2       ;;

 +3       ; The following line prevents the "Disable Options..." and "Move

 +4       ; Routines..." questions from being asked during the install.

 +5        FOR X="XPO1","XPZ1","XPZ2","XPI1"

               SET XPDDIQ(X)=0

 +6        QUIT

 +7       ;

PRE       ;EP

 +1        FOR DA=1:1:500

               SET DIK="^BNIGRI("

               DO ^DIK

 +2        QUIT

POST      ;EP

 +1        SET DIK(1)=".01^AE"

           SET DIK="^BNIREC("

           DO ENALL^DIK

 +2        KILL DIK

 +3       ;move ado schemas to bmx ado schema

 +4        SET BNIX=0

FOR

               SET BNIX=$ORDER(^BNIADO(BNIX))

               IF BNIX'=+BNIX

                   QUIT

               Begin DoDot:1

 +5                SET BNIN=$PIECE(^BNIADO(BNIX,0),U)

 +6       ;already in file

                   IF $DATA(^BMXADO("B",BNIN))

                       QUIT

 +7                SET G=0

                   SET X=0

FOR

                       SET X=$ORDER(^BMXADO(X))

                       IF X'=+X!(G)

                           QUIT

                       IF $PIECE(^BMXADO(X,0),U)=BNIN

                           SET G=1

 +8                IF G

                       QUIT

 +9                SET X=BNIN

                   SET DIC="^BMXADO("

                   SET DIADD=1

                   SET DLAYGO=90093.99

                   SET DIC(0)="AEMQL"

                   KILL DO,D0,DD

                   DO FILE^DICN

 +10               IF Y=-1

                       WRITE !!,"Failure to add BMX ADO Schema ",BNIN

                       KILL DIADD,DLAYGO,DIC,DA

                       QUIT

 +11               SET BNIDA=+Y

 +12               KILL DIADD,DLAYGO,DIC,DA

                   DO ^XBFMK

 +13               MERGE ^BMXADO(BNIDA)=^BNIADO(BNIX)

 +14               SET DA=BNIDA

                   SET DIK="^BMXADO("

                   DO IX1^DIK

                   KILL DA,DIK

               End DoDot:1

 +15       QUIT

BNIPOST.m