- 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 Feb 18, 2025@23:18 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