- DGPMVBM ;ALB/MIR - BUILDING MANAGMENT BULLETIN GENERATOR ; 9 OCT 90
- ;;5.3;Registration;;Aug 13, 1993
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMVBM 3013 printed Mar 13, 2025@21:55:07 Page 2
- DGPMVBM ;ALB/MIR - BUILDING MANAGMENT BULLETIN GENERATOR ; 9 OCT 90
- +1 ;;5.3;Registration;;Aug 13, 1993
- +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
