ADGBULL.m

ADGBULL ; IHS/ADC/PDW/ENM - POST ADT BULLETINS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

BULL ;***> MANUALLY POST A BULLETIN

 D ^XBCLS W !!?20,"MANUALLY POST BULLETIN THAT A&D SHEET IS READY",!!

 W !,"Fill in the date for the message below:",!

 S DIC(0)="EQMZ",DIC="^XMB(3.6," D ^DIC Q:Y<0

 S XMB=$P(Y(0),U,1),XMJ=0 F I=1:1 S XMJ=$O(^XMB(3.6,+Y,1,XMJ)) Q:XMJ=""  W !,^(XMJ,0)

 W ! NEW DIR,DIRUT S DIR(0)="FO",DIR("A")="Enter A&D Sheet Date" D ^DIR

 Q:$D(DIRUT)  S XMB(1)=Y

 NEW DIR,DIRUT S DIR(0)="Y0",DIR("A")="Okay to Post Bulletin Now"

 D ^DIR Q:$D(DIRUT)  K XMDT S XMT=0 D ^XMB

END Q

 ;

ADS ;EP

 S X="DG IHS A&D" G BULL  ;A&D SHEET BULLETIN

ADGBULL   ; IHS/ADC/PDW/ENM - POST ADT BULLETINS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

BULL      ;***> MANUALLY POST A BULLETIN

 +1        DO ^XBCLS

           WRITE !!?20,"MANUALLY POST BULLETIN THAT A&D SHEET IS READY",!!

 +2        WRITE !,"Fill in the date for the message below:",!

 +3        SET DIC(0)="EQMZ"

           SET DIC="^XMB(3.6,"

           DO ^DIC

           IF Y<0

               QUIT 

 +4        SET XMB=$PIECE(Y(0),U,1)

           SET XMJ=0

           FOR I=1:1

               SET XMJ=$ORDER(^XMB(3.6,+Y,1,XMJ))

               IF XMJ=""

                   QUIT 

               WRITE !,^(XMJ,0)

 +5        WRITE !

           NEW DIR,DIRUT

           SET DIR(0)="FO"

           SET DIR("A")="Enter A&D Sheet Date"

           DO ^DIR

 +6        IF $DATA(DIRUT)

               QUIT 

           SET XMB(1)=Y

 +7        NEW DIR,DIRUT

           SET DIR(0)="Y0"

           SET DIR("A")="Okay to Post Bulletin Now"

 +8        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

           KILL XMDT

           SET XMT=0

           DO ^XMB

END        QUIT 

 +1       ;

ADS       ;EP

 +1       ;A&D SHEET BULLETIN

           SET X="DG IHS A&D"

           GOTO BULL