DGPMVBM.m

DGPMVBM ;ALB/MIR - BUILDING MANAGMENT BULLETIN GENERATOR ; 9 OCT 90

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;This routine will generate a bulletin to building management (if

 ;a site so desires).  This bulletin gets fired under the following

 ;conditions:

 ;

 ;1 - The site must choose to have a bulletin generated by assigning

 ;    members to the DG BLDG MANAGEMENT mailgroup.  If there are no

 ;    members, no bulletin will be generated.

 ;2 - The entry must not be a deletion.

 ;3 - If the entry is new and it's a a transfer, discharge, or check-

 ;    out lodger and it is the last movement on file (not a back-date).

 ;4 - if it's the latest movement, it's an edit, and it's an admission,

 ;    transfer, or check-in lodger, the user will be asked whether they

 ;    want to generate a bulletin or not.

 ;

EN ;begin checks for bulletin generation

 S DGPMX=$O(^XMB(3.8,"B","DG BLDG MANAGEMENT",0)) I '$O(^XMB(3.8,+DGPMX,1,0)) K DGPMX Q  ;if no mailgroup members, quit

 I DGPMT=6!'DGPMA Q

 D NOW^%DTC S X=$O(^DGPM("APRD",DFN,+DGPMA+.0000005)),X=$O(^(+X,0)),X=$S($D(^DGPM(+X,0)):+^(0),1:0) I X,(X<%) G Q ;quit if not latest movement...check for pseudo d/c

 I 'DGPMP,("^2^3^5^"[("^"_DGPMT_"^")) D SET Q

 I 'DGPMP!("^1^2^4^"'[("^"_DGPMT_"^")) D Q Q

 ;edit existing entry for admit, xfr, or check-in...set variables

 I $P(DGPMP,"^",7)=$P(DGPMA,"^",7)!'$P(DGPMP,"^",7) D Q Q

 W !!,"You have made a change to the room-bed."

ASK ;ask if bulletin should be sent

 W !,"Do you want to notify Building Management" S %=1 D YN^DICN I %<0!(%=2) D Q Q

 I '% W !?3,"Respond 'Y'es to notify Building Management of vacated bed, otherwise, 'N'o." G ASK

 S DGPMOW=$P(DGPMP,"^",6),DGPMOB=$P(DGPMP,"^",7) D FILE,Q Q

SET ;set up variables for new transfers, discharges, or check-outs

 I DGPMT=2!(DGPMT=3) S X=$O(^DGPM("APID",DFN,10000000-+DGPMA)),X=$O(^(+X,0)) I $D(^DGPM(+X,0)) S DGPMOB=$P(^(0),"^",7),DGPMOW=$P(^(0),"^",6) I 'DGPMOB D Q Q

 I DGPMT=5 S X=$P(DGPMAN,"^",14) I $D(^DGPM(+X,0)) S DGPMOB=$P(^(0),"^",7),DGPMOW=$P(^(0),"^",6) I 'DGPMOB D Q Q

 I '$D(DGPMOB) D Q Q

FILE ;send bulletin

 I '$D(^DG(405.4,+DGPMOB,0)) D Q Q

 K ^UTILITY("DGPM BLDG MGMT",$J,"TEXT")

 S XMSUB="Room-bed Vacated",XMTEXT="^UTILITY(""DGPM BLDG MGMT"",$J,""TEXT"",",DGPMBLN=0

 N XMCHAN S X="G.DG BLDG MANAGEMENT",XMDUZ=DUZ,XMCHAN=1 D WHO^XMA21

 S DGPMBL=" " D SETLN

 S DGPMBL="Room-bed "_$P(^DG(405.4,+DGPMOB,0),"^",1)_" on ward "_$S($D(^DIC(42,+DGPMOW,0)):$P(^(0),"^",1),1:"UNKNOWN")_" has been vacated." D SETLN

 S DGPMBL="This bed will require cleaning." D SETLN

 S DGPMBL=" " D SETLN

 S DGPMBL="Patient Movement:  "_$S(DGPMT=1:"ADMISSION",DGPMT=2:"TRANSFER",DGPMT=3:"DISCHARGE",DGPMT=4:"CHECK-IN LODGER",DGPMT=5:"CHECK-OUT LODGER",1:"UNKNOWN") D SETLN

 S DGPMBL=" " D SETLN

 D ^XMD

 K ^UTILITY("DGPM BLDG MGMT",$J),DGPMBL,DGPMBLN,XMY,XMSUB,XMTEXT

Q K %,%Y,DGPMOB,DGPMOW,DGPMX,I,X Q

SETLN ; -- set line in xmtext array

 S DGPMBLN=DGPMBLN+1

 S ^UTILITY("DGPM BLDG MGMT",$J,"TEXT",DGPMBLN,0)=DGPMBL

 Q

DGPMVBM   ;ALB/MIR - BUILDING MANAGMENT BULLETIN GENERATOR ; 9 OCT 90

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2       ;This routine will generate a bulletin to building management (if

 +3       ;a site so desires).  This bulletin gets fired under the following

 +4       ;conditions:

 +5       ;

 +6       ;1 - The site must choose to have a bulletin generated by assigning

 +7       ;    members to the DG BLDG MANAGEMENT mailgroup.  If there are no

 +8       ;    members, no bulletin will be generated.

 +9       ;2 - The entry must not be a deletion.

 +10      ;3 - If the entry is new and it's a a transfer, discharge, or check-

 +11      ;    out lodger and it is the last movement on file (not a back-date).

 +12      ;4 - if it's the latest movement, it's an edit, and it's an admission,

 +13      ;    transfer, or check-in lodger, the user will be asked whether they

 +14      ;    want to generate a bulletin or not.

 +15      ;

EN        ;begin checks for bulletin generation

 +1       ;if no mailgroup members, quit

           SET DGPMX=$ORDER(^XMB(3.8,"B","DG BLDG MANAGEMENT",0))

           IF '$ORDER(^XMB(3.8,+DGPMX,1,0))

               KILL DGPMX

               QUIT 

 +2        IF DGPMT=6!'DGPMA

               QUIT 

 +3       ;quit if not latest movement...check for pseudo d/c

           DO NOW^%DTC

           SET X=$ORDER(^DGPM("APRD",DFN,+DGPMA+.0000005))

           SET X=$ORDER(^(+X,0))

           SET X=$SELECT($DATA(^DGPM(+X,0)):+^(0),1:0)

           IF X

               IF (X<%)

                   GOTO Q

 +4        IF 'DGPMP

               IF ("^2^3^5^"[("^"_DGPMT_"^"))

                   DO SET

                   QUIT 

 +5        IF 'DGPMP!("^1^2^4^"'[("^"_DGPMT_"^"))

               DO Q

               QUIT 

 +6       ;edit existing entry for admit, xfr, or check-in...set variables

 +7        IF $PIECE(DGPMP,"^",7)=$PIECE(DGPMA,"^",7)!'$PIECE(DGPMP,"^",7)

               DO Q

               QUIT 

 +8        WRITE !!,"You have made a change to the room-bed."

ASK       ;ask if bulletin should be sent

 +1        WRITE !,"Do you want to notify Building Management"

           SET %=1

           DO YN^DICN

           IF %<0!(%=2)

               DO Q

               QUIT 

 +2        IF '%

               WRITE !?3,"Respond 'Y'es to notify Building Management of vacated bed, otherwise, 'N'o."

               GOTO ASK

 +3        SET DGPMOW=$PIECE(DGPMP,"^",6)

           SET DGPMOB=$PIECE(DGPMP,"^",7)

           DO FILE

           DO Q

           QUIT 

SET       ;set up variables for new transfers, discharges, or check-outs

 +1        IF DGPMT=2!(DGPMT=3)

               SET X=$ORDER(^DGPM("APID",DFN,10000000-+DGPMA))

               SET X=$ORDER(^(+X,0))

               IF $DATA(^DGPM(+X,0))

                   SET DGPMOB=$PIECE(^(0),"^",7)

                   SET DGPMOW=$PIECE(^(0),"^",6)

                   IF 'DGPMOB

                       DO Q

                       QUIT 

 +2        IF DGPMT=5

               SET X=$PIECE(DGPMAN,"^",14)

               IF $DATA(^DGPM(+X,0))

                   SET DGPMOB=$PIECE(^(0),"^",7)

                   SET DGPMOW=$PIECE(^(0),"^",6)

                   IF 'DGPMOB

                       DO Q

                       QUIT 

 +3        IF '$DATA(DGPMOB)

               DO Q

               QUIT 

FILE      ;send bulletin

 +1        IF '$DATA(^DG(405.4,+DGPMOB,0))

               DO Q

               QUIT 

 +2        KILL ^UTILITY("DGPM BLDG MGMT",$JOB,"TEXT")

 +3        SET XMSUB="Room-bed Vacated"

           SET XMTEXT="^UTILITY(""DGPM BLDG MGMT"",$J,""TEXT"","

           SET DGPMBLN=0

 +4        NEW XMCHAN

           SET X="G.DG BLDG MANAGEMENT"

           SET XMDUZ=DUZ

           SET XMCHAN=1

           DO WHO^XMA21

 +5        SET DGPMBL=" "

           DO SETLN

 +6        SET DGPMBL="Room-bed "_$PIECE(^DG(405.4,+DGPMOB,0),"^",1)_" on ward "_$SELECT($DATA(^DIC(42,+DGPMOW,0)):$PIECE(^(0),"^",1),1:"UNKNOWN")_" has been vacated."

           DO SETLN

 +7        SET DGPMBL="This bed will require cleaning."

           DO SETLN

 +8        SET DGPMBL=" "

           DO SETLN

 +9        SET DGPMBL="Patient Movement:  "_$SELECT(DGPMT=1:"ADMISSION",DGPMT=2:"TRANSFER",DGPMT=3:"DISCHARGE",DGPMT=4:"CHECK-IN LODGER",DGPMT=5:"CHECK-OUT LODGER",1:"UNKNOWN")

           DO SETLN

 +10       SET DGPMBL=" "

           DO SETLN

 +11       DO ^XMD

 +12       KILL ^UTILITY("DGPM BLDG MGMT",$JOB),DGPMBL,DGPMBLN,XMY,XMSUB,XMTEXT

Q          KILL %,%Y,DGPMOB,DGPMOW,DGPMX,I,X

           QUIT 

SETLN     ; -- set line in xmtext array

 +1        SET DGPMBLN=DGPMBLN+1

 +2        SET ^UTILITY("DGPM BLDG MGMT",$JOB,"TEXT",DGPMBLN,0)=DGPMBL

 +3        QUIT