| 1 | DGPMVBM ;ALB/MIR - BUILDING MANAGMENT BULLETIN GENERATOR ; 9 OCT 90
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;This routine will generate a bulletin to building management (if
|
|---|
| 4 | ;a site so desires). This bulletin gets fired under the following
|
|---|
| 5 | ;conditions:
|
|---|
| 6 | ;
|
|---|
| 7 | ;1 - The site must choose to have a bulletin generated by assigning
|
|---|
| 8 | ; members to the DG BLDG MANAGEMENT mailgroup. If there are no
|
|---|
| 9 | ; members, no bulletin will be generated.
|
|---|
| 10 | ;2 - The entry must not be a deletion.
|
|---|
| 11 | ;3 - If the entry is new and it's a a transfer, discharge, or check-
|
|---|
| 12 | ; out lodger and it is the last movement on file (not a back-date).
|
|---|
| 13 | ;4 - if it's the latest movement, it's an edit, and it's an admission,
|
|---|
| 14 | ; transfer, or check-in lodger, the user will be asked whether they
|
|---|
| 15 | ; want to generate a bulletin or not.
|
|---|
| 16 | ;
|
|---|
| 17 | EN ;begin checks for bulletin generation
|
|---|
| 18 | 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
|
|---|
| 19 | I DGPMT=6!'DGPMA Q
|
|---|
| 20 | 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
|
|---|
| 21 | I 'DGPMP,("^2^3^5^"[("^"_DGPMT_"^")) D SET Q
|
|---|
| 22 | I 'DGPMP!("^1^2^4^"'[("^"_DGPMT_"^")) D Q Q
|
|---|
| 23 | ;edit existing entry for admit, xfr, or check-in...set variables
|
|---|
| 24 | I $P(DGPMP,"^",7)=$P(DGPMA,"^",7)!'$P(DGPMP,"^",7) D Q Q
|
|---|
| 25 | W !!,"You have made a change to the room-bed."
|
|---|
| 26 | ASK ;ask if bulletin should be sent
|
|---|
| 27 | W !,"Do you want to notify Building Management" S %=1 D YN^DICN I %<0!(%=2) D Q Q
|
|---|
| 28 | I '% W !?3,"Respond 'Y'es to notify Building Management of vacated bed, otherwise, 'N'o." G ASK
|
|---|
| 29 | S DGPMOW=$P(DGPMP,"^",6),DGPMOB=$P(DGPMP,"^",7) D FILE,Q Q
|
|---|
| 30 | SET ;set up variables for new transfers, discharges, or check-outs
|
|---|
| 31 | 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
|
|---|
| 32 | 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
|
|---|
| 33 | I '$D(DGPMOB) D Q Q
|
|---|
| 34 | FILE ;send bulletin
|
|---|
| 35 | I '$D(^DG(405.4,+DGPMOB,0)) D Q Q
|
|---|
| 36 | K ^UTILITY("DGPM BLDG MGMT",$J,"TEXT")
|
|---|
| 37 | S XMSUB="Room-bed Vacated",XMTEXT="^UTILITY(""DGPM BLDG MGMT"",$J,""TEXT"",",DGPMBLN=0
|
|---|
| 38 | N XMCHAN S X="G.DG BLDG MANAGEMENT",XMDUZ=DUZ,XMCHAN=1 D WHO^XMA21
|
|---|
| 39 | S DGPMBL=" " D SETLN
|
|---|
| 40 | 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
|
|---|
| 41 | S DGPMBL="This bed will require cleaning." D SETLN
|
|---|
| 42 | S DGPMBL=" " D SETLN
|
|---|
| 43 | 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
|
|---|
| 44 | S DGPMBL=" " D SETLN
|
|---|
| 45 | D ^XMD
|
|---|
| 46 | K ^UTILITY("DGPM BLDG MGMT",$J),DGPMBL,DGPMBLN,XMY,XMSUB,XMTEXT
|
|---|
| 47 | Q K %,%Y,DGPMOB,DGPMOW,DGPMX,I,X Q
|
|---|
| 48 | SETLN ; -- set line in xmtext array
|
|---|
| 49 | S DGPMBLN=DGPMBLN+1
|
|---|
| 50 | S ^UTILITY("DGPM BLDG MGMT",$J,"TEXT",DGPMBLN,0)=DGPMBL
|
|---|
| 51 | Q
|
|---|
