EDPBRM ;SLC/KCM - Room/Bed Configuration ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
LOAD(AREA) ; Load the list of rooms/beds for this area
N BED,SEQ,BEDS,X0,TOKEN
;
D READL^EDPBLK(AREA,"bed",.TOKEN) ; read bed config -- LOCK
D XML^EDPX("<bedToken>"_TOKEN_"</bedToken>")
;
; Get a list of all the beds in sequence for this area
S BED=0 F S BED=$O(^EDPB(231.8,"C",EDPSITE,AREA,BED)) Q:'BED D
. S SEQ=$P(^EDPB(231.8,BED,0),U,5) S:'SEQ SEQ=99999
. S BEDS(SEQ,BED)=""
;
; Build the XML for each bed in sequence
D XML^EDPX("<beds>")
S SEQ=0 F S SEQ=$O(BEDS(SEQ)) Q:'SEQ D
. S BED=0 F S BED=$O(BEDS(SEQ,BED)) Q:'BED D
. . S X0=^EDPB(231.8,BED,0)
. . ; Patch 6 (BWF) 4/24/2013 - do not display EDIS_DEFAULT bed
. . I $P(X0,U)="EDIS_DEFAULT" Q
. . N X
. . S X("id")=BED
. . S X("name")=$P(X0,U)
. . S X("site")=$P(X0,U,2)
. . S X("area")=$P(X0,U,3)
. . S X("inactive")=$P(X0,U,4)
. . S X("seq")=$P(X0,U,5)
. . S X("display")=$P(X0,U,6)
. . S X("when")=$P(X0,U,7)
. . S X("status")=$P(X0,U,8)
. . S X("category")=$P(X0,U,9)
. . S X("shared")=$P(X0,U,10)
. . S X("board")=$P(X0,U,11)
. . S X("color")=$P(X0,U,12)
. . S X("primary")=$S($P(X0,U,13)=2:2,1:1,1:"") ; ""=unknown,1=primary,2=secondary
. . D XML^EDPX($$XMLA^EDPX("bed",.X))
D XML^EDPX("</beds>")
;
D READU^EDPBLK(AREA,"bed",.TOKEN) ; read bed config -- UNLOCK
Q
SAVE(REQ,AREA) ; Save the updated bed list
; loop thru the records and update where changed
N X,BED,ERR,TOKEN,LOCKERR
;
S TOKEN=$G(REQ("bedToken",1))
D SAVEL^EDPBLK(AREA,"bed",.TOKEN,.LOCKERR) ; save bed config -- LOCK
I $L(LOCKERR) D SAVERR^EDPX("collide",LOCKERR),LOAD(AREA),DFLTRM(AREA) Q
;
S X="bed-",ERR=""
F S X=$O(REQ(X)) Q:$E(X,1,4)'="bed-" D
. K BED S BED=""
. D NVPARSE^EDPX(.BED,REQ(X,1))
. S BED("name")=$$TRIM^XLFSTR(BED("name"))
. I '$L(BED("name")) S ERR=ERR_"Name may not be blank. " Q
. I BED("changed") D UPD(.BED,.ERR)
D SAVEU^EDPBLK(AREA,"bed",.TOKEN) ; save bed config -- UNLOCK
;
I $L(ERR) D SAVERR^EDPX("fail",ERR) Q
D XML^EDPX("<save status='ok' />")
D LOAD(AREA) ; return updated list of beds
D DFLTRM(AREA) ; return new default lists of beds
Q
UPD(FLD,ERRMSG) ; Add/Update Record
N EDPIEN
S EDPIEN=FLD("id")_","
I FLD("id")=0 S EDPIEN="+1,"
;
N FDA,FDAIEN,DIERR,ERR
S FDA(231.8,EDPIEN,.01)=FLD("name")
S FDA(231.8,EDPIEN,.02)=EDPSITE
S FDA(231.8,EDPIEN,.03)=FLD("area")
S FDA(231.8,EDPIEN,.04)=FLD("inactive")
S FDA(231.8,EDPIEN,.05)=FLD("seq")
S FDA(231.8,EDPIEN,.06)=FLD("display")
S FDA(231.8,EDPIEN,.07)=FLD("when")
S FDA(231.8,EDPIEN,.08)=FLD("status")
S FDA(231.8,EDPIEN,.09)=FLD("category")
S FDA(231.8,EDPIEN,.1)=FLD("shared")
S FDA(231.8,EDPIEN,.11)=FLD("board")
S FDA(231.8,EDPIEN,.12)=FLD("color")
S FDA(231.8,EDPIEN,.13)=$S($G(FLD("primary"))=1:1,2:2,1:"")
I EDPIEN="+1," D
. D UPDATE^DIE("","FDA","FDAIEN","ERR")
. I $D(DIERR) S ERRMSG=ERRMSG_"Adding "_FLD("name")_" failed. "
E D
. D FILE^DIE("","FDA","ERR")
. I $D(DIERR) S ERRMSG=ERRMSG_"Updating "_FLD("name")_" failed. "
D CLEAN^DILF
Q
DFLTRM(AREA) ; Load the multi-areas
N BED,X,X0,ALPHA
D XML^EDPX("<defaultRoomList>")
; bwf patch 6 4/26/2013 - removed following line, do not want "None Selected"
;D XML^EDPX($$XMLS^EDPX("item",-1,"(None Selected)")) ;non-selected (-1 will delete)
S BED=0 F S BED=$O(^EDPB(231.8,"C",EDPSITE,AREA,BED)) Q:'BED D
. S X0=^EDPB(231.8,BED,0)
. ; bwf patch 6 4/25/2013 - filter EDIS_DEFAULT
. I $P(X0,U)="EDIS_DEFAULT" Q
. I $P(X0,U,4) Q ; inactive
. I ($P(X0,U,9)=1)!($P(X0,U,9)=2) S ALPHA($P(X0,U)_" ("_$P(X0,U,6)_")")=BED
S X="" F S X=$O(ALPHA(X)) Q:X="" D XML^EDPX($$XMLS^EDPX("item",ALPHA(X),X))
D XML^EDPX("</defaultRoomList>")
Q
CHOICES ; Load the choice lists
N I,X
F I=1:1 S X=$P($T(WHEN+I),";",3,99) Q:X="ZZZZZ" D XML^EDPX(X)
F I=1:1 S X=$P($T(CATS+I),";",3,99) Q:X="ZZZZZ" D XML^EDPX(X)
D CODES^EDPQLE1("status","status")
Q
WHEN ; Display When Choices
;;<displayWhen>
;;<when label="Occupied" data="0" />
;;<when label="Always" data="1" />
;;<when label="Never" data="2" />
;;</displayWhen>
;;ZZZZZ
CATS ; Category Choices
;;<roomCategories>
;;<item abbr="Single Pt" data="0" label="Single Pt (one patient assigned)" />
;;<item abbr="Multiple Pt" data="1" label="Multiple Pt (multiple patients assigned)" />
;;<item abbr="Waiting Area" data="2" label="Waiting Area (multiple patients assigned)" />
;;<item abbr="Single Non-ED" data="3" label="Single Non-ED (one patient assigned, outside of ED)" />
;;<item abbr="Multiple Non-ED" data="4" label="Multiple Non-ED (multiple patients assigned, outside of ED)" />
;;</roomCategories>
;;ZZZZZ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBRM 4798 printed Dec 13, 2024@01:51:35 Page 2
EDPBRM ;SLC/KCM - Room/Bed Configuration ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
LOAD(AREA) ; Load the list of rooms/beds for this area
+1 NEW BED,SEQ,BEDS,X0,TOKEN
+2 ;
+3 ; read bed config -- LOCK
DO READL^EDPBLK(AREA,"bed",.TOKEN)
+4 DO XML^EDPX("<bedToken>"_TOKEN_"</bedToken>")
+5 ;
+6 ; Get a list of all the beds in sequence for this area
+7 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+8 SET SEQ=$PIECE(^EDPB(231.8,BED,0),U,5)
if 'SEQ
SET SEQ=99999
+9 SET BEDS(SEQ,BED)=""
End DoDot:1
+10 ;
+11 ; Build the XML for each bed in sequence
+12 DO XML^EDPX("<beds>")
+13 SET SEQ=0
FOR
SET SEQ=$ORDER(BEDS(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+14 SET BED=0
FOR
SET BED=$ORDER(BEDS(SEQ,BED))
if 'BED
QUIT
Begin DoDot:2
+15 SET X0=^EDPB(231.8,BED,0)
+16 ; Patch 6 (BWF) 4/24/2013 - do not display EDIS_DEFAULT bed
+17 IF $PIECE(X0,U)="EDIS_DEFAULT"
QUIT
+18 NEW X
+19 SET X("id")=BED
+20 SET X("name")=$PIECE(X0,U)
+21 SET X("site")=$PIECE(X0,U,2)
+22 SET X("area")=$PIECE(X0,U,3)
+23 SET X("inactive")=$PIECE(X0,U,4)
+24 SET X("seq")=$PIECE(X0,U,5)
+25 SET X("display")=$PIECE(X0,U,6)
+26 SET X("when")=$PIECE(X0,U,7)
+27 SET X("status")=$PIECE(X0,U,8)
+28 SET X("category")=$PIECE(X0,U,9)
+29 SET X("shared")=$PIECE(X0,U,10)
+30 SET X("board")=$PIECE(X0,U,11)
+31 SET X("color")=$PIECE(X0,U,12)
+32 ; ""=unknown,1=primary,2=secondary
SET X("primary")=$SELECT($PIECE(X0,U,13)=2:2,1:1,1:"")
+33 DO XML^EDPX($$XMLA^EDPX("bed",.X))
End DoDot:2
End DoDot:1
+34 DO XML^EDPX("</beds>")
+35 ;
+36 ; read bed config -- UNLOCK
DO READU^EDPBLK(AREA,"bed",.TOKEN)
+37 QUIT
SAVE(REQ,AREA) ; Save the updated bed list
+1 ; loop thru the records and update where changed
+2 NEW X,BED,ERR,TOKEN,LOCKERR
+3 ;
+4 SET TOKEN=$GET(REQ("bedToken",1))
+5 ; save bed config -- LOCK
DO SAVEL^EDPBLK(AREA,"bed",.TOKEN,.LOCKERR)
+6 IF $LENGTH(LOCKERR)
DO SAVERR^EDPX("collide",LOCKERR)
DO LOAD(AREA)
DO DFLTRM(AREA)
QUIT
+7 ;
+8 SET X="bed-"
SET ERR=""
+9 FOR
SET X=$ORDER(REQ(X))
if $EXTRACT(X,1,4)'="bed-"
QUIT
Begin DoDot:1
+10 KILL BED
SET BED=""
+11 DO NVPARSE^EDPX(.BED,REQ(X,1))
+12 SET BED("name")=$$TRIM^XLFSTR(BED("name"))
+13 IF '$LENGTH(BED("name"))
SET ERR=ERR_"Name may not be blank. "
QUIT
+14 IF BED("changed")
DO UPD(.BED,.ERR)
End DoDot:1
+15 ; save bed config -- UNLOCK
DO SAVEU^EDPBLK(AREA,"bed",.TOKEN)
+16 ;
+17 IF $LENGTH(ERR)
DO SAVERR^EDPX("fail",ERR)
QUIT
+18 DO XML^EDPX("<save status='ok' />")
+19 ; return updated list of beds
DO LOAD(AREA)
+20 ; return new default lists of beds
DO DFLTRM(AREA)
+21 QUIT
UPD(FLD,ERRMSG) ; Add/Update Record
+1 NEW EDPIEN
+2 SET EDPIEN=FLD("id")_","
+3 IF FLD("id")=0
SET EDPIEN="+1,"
+4 ;
+5 NEW FDA,FDAIEN,DIERR,ERR
+6 SET FDA(231.8,EDPIEN,.01)=FLD("name")
+7 SET FDA(231.8,EDPIEN,.02)=EDPSITE
+8 SET FDA(231.8,EDPIEN,.03)=FLD("area")
+9 SET FDA(231.8,EDPIEN,.04)=FLD("inactive")
+10 SET FDA(231.8,EDPIEN,.05)=FLD("seq")
+11 SET FDA(231.8,EDPIEN,.06)=FLD("display")
+12 SET FDA(231.8,EDPIEN,.07)=FLD("when")
+13 SET FDA(231.8,EDPIEN,.08)=FLD("status")
+14 SET FDA(231.8,EDPIEN,.09)=FLD("category")
+15 SET FDA(231.8,EDPIEN,.1)=FLD("shared")
+16 SET FDA(231.8,EDPIEN,.11)=FLD("board")
+17 SET FDA(231.8,EDPIEN,.12)=FLD("color")
+18 SET FDA(231.8,EDPIEN,.13)=$SELECT($GET(FLD("primary"))=1:1,2:2,1:"")
+19 IF EDPIEN="+1,"
Begin DoDot:1
+20 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+21 IF $DATA(DIERR)
SET ERRMSG=ERRMSG_"Adding "_FLD("name")_" failed. "
End DoDot:1
+22 IF '$TEST
Begin DoDot:1
+23 DO FILE^DIE("","FDA","ERR")
+24 IF $DATA(DIERR)
SET ERRMSG=ERRMSG_"Updating "_FLD("name")_" failed. "
End DoDot:1
+25 DO CLEAN^DILF
+26 QUIT
DFLTRM(AREA) ; Load the multi-areas
+1 NEW BED,X,X0,ALPHA
+2 DO XML^EDPX("<defaultRoomList>")
+3 ; bwf patch 6 4/26/2013 - removed following line, do not want "None Selected"
+4 ;D XML^EDPX($$XMLS^EDPX("item",-1,"(None Selected)")) ;non-selected (-1 will delete)
+5 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+6 SET X0=^EDPB(231.8,BED,0)
+7 ; bwf patch 6 4/25/2013 - filter EDIS_DEFAULT
+8 IF $PIECE(X0,U)="EDIS_DEFAULT"
QUIT
+9 ; inactive
IF $PIECE(X0,U,4)
QUIT
+10 IF ($PIECE(X0,U,9)=1)!($PIECE(X0,U,9)=2)
SET ALPHA($PIECE(X0,U)_" ("_$PIECE(X0,U,6)_")")=BED
End DoDot:1
+11 SET X=""
FOR
SET X=$ORDER(ALPHA(X))
if X=""
QUIT
DO XML^EDPX($$XMLS^EDPX("item",ALPHA(X),X))
+12 DO XML^EDPX("</defaultRoomList>")
+13 QUIT
CHOICES ; Load the choice lists
+1 NEW I,X
+2 FOR I=1:1
SET X=$PIECE($TEXT(WHEN+I),";",3,99)
if X="ZZZZZ"
QUIT
DO XML^EDPX(X)
+3 FOR I=1:1
SET X=$PIECE($TEXT(CATS+I),";",3,99)
if X="ZZZZZ"
QUIT
DO XML^EDPX(X)
+4 DO CODES^EDPQLE1("status","status")
+5 QUIT
WHEN ; Display When Choices
+1 ;;<displayWhen>
+2 ;;<when label="Occupied" data="0" />
+3 ;;<when label="Always" data="1" />
+4 ;;<when label="Never" data="2" />
+5 ;;</displayWhen>
+6 ;;ZZZZZ
CATS ; Category Choices
+1 ;;<roomCategories>
+2 ;;<item abbr="Single Pt" data="0" label="Single Pt (one patient assigned)" />
+3 ;;<item abbr="Multiple Pt" data="1" label="Multiple Pt (multiple patients assigned)" />
+4 ;;<item abbr="Waiting Area" data="2" label="Waiting Area (multiple patients assigned)" />
+5 ;;<item abbr="Single Non-ED" data="3" label="Single Non-ED (one patient assigned, outside of ED)" />
+6 ;;<item abbr="Multiple Non-ED" data="4" label="Multiple Non-ED (multiple patients assigned, outside of ED)" />
+7 ;;</roomCategories>
+8 ;;ZZZZZ
