EDPBCF ;SLC/KCM - Display Board Configuration ; 3/29/23 12:17pm
;;2.0;EMERGENCY DEPARTMENT;**6,23**;Feb 24, 2012;Build 4
;
LOAD(AREA) ; Load General Configuration for an Area
N I,NODE
;
D XML^EDPX("<colorMaps>")
D COLORS^EDPBCM
D XML^EDPX("</colorMaps>")
D LOAD^EDPBCM(AREA) ; load the color spec
;
D LOAD^EDPBRM(AREA) ; load rooms/beds
D DFLTRM^EDPBRM(AREA) ; load multi rooms
;
D LOAD^EDPBPM(AREA) ; load parameters
;
D XML^EDPX("<columnList>") ; load available columns
F I=1:1 S NODE=$P($T(COLUMNS+I),";",3,99) Q:$E(NODE,1,5)="zzzzz" D
. N X
. S X("label")=$P(NODE,U)
. S X("att")=$P(NODE,U,2)
. S X("header")=$P(NODE,U,3)
. S X("width")=50
. D XML^EDPX($$XMLA^EDPX("col",.X))
D XML^EDPX("</columnList>")
;
D CHOICES^EDPBRM ; load 'display when' choices
;
N EDPSCRNS D GETLST^XPAR(.EDPSCRNS,"ALL","EDPF SCREEN SIZES","I")
D XML^EDPX("<screenSizes>")
S I=0 F S I=$O(EDPSCRNS(I)) Q:'I D
. S EDPSCRNS(I)=$TR(EDPSCRNS(I),"X","x")
. N X
. S X("label")=EDPSCRNS(I)
. S X("width")=$P(EDPSCRNS(I),"x")
. S X("height")=$P(EDPSCRNS(I),"x",2)
. D XML^EDPX($$XMLA^EDPX("size",.X))
D XML^EDPX("</screenSizes>")
Q
LOADBRD(AREA,IEN) ; Load Named Board Spec
N I,X,TOKEN
S:'IEN IEN=$O(^EDPB(231.9,AREA,4,0)) Q:'IEN
;
D READL^EDPBLK(AREA,"board",.TOKEN) ; read lock the board config
D LOAD^EDPBPM(AREA) ;Load Parameters *23
D XML^EDPX("<boardToken>"_TOKEN_"</boardToken>")
D BRDLST(AREA)
S X("boardID")=IEN,X("boardName")=$P(^EDPB(231.9,AREA,4,IEN,0),U)
D XML^EDPX($$XMLA^EDPX("spec",.X,""))
S I=0 F S I=$O(^EDPB(231.9,AREA,4,IEN,1,I)) Q:'I D
. D XML^EDPX(^EDPB(231.9,AREA,4,IEN,1,I,0))
D XML^EDPX("</spec>")
D READU^EDPBLK(AREA,"board",.TOKEN) ; read unlock the board config
Q
BRDLST(AREA) ; List of boards
N I,X
D XML^EDPX("<boards>")
S I=0 F S I=$O(^EDPB(231.9,AREA,4,I)) Q:'I D
. S X=$P(^EDPB(231.9,AREA,4,I,0),U)
. D XML^EDPX($$XMLS^EDPX("board",I,X))
D XML^EDPX("</boards>")
Q
SAVEBRD(REQ) ; Save Configuration
N X,AREA,DFLTNM
S X="col-",AREA=$G(REQ("area",1)),DFLTNM="Main (default)"
I 'AREA D SAVERR^EDPX("fail","Missing area") Q
;
N NAME,IEN,WP,MSG
S NAME=$G(REQ("boardName",1)),IEN=+$G(REQ("boardID",1))
I (IEN>0),($P(^EDPB(231.9,AREA,4,IEN,0),U)=DFLTNM),(NAME'=DFLTNM) D Q
. D SAVERR^EDPX("fail","Default name may not be changed.")
I NAME="" D Q
. D SAVERR^EDPX("fail","Missing name")
I (IEN=0),$O(^EDPB(231.9,AREA,4,"B",NAME,0)) D Q
. D SAVERR^EDPX("fail","Board name must be unique")
;
; save XML spec as word processing
N TOKEN,LOCKERR
S TOKEN=$G(REQ("boardToken",1))
D SAVEL^EDPBLK(AREA,"board",.TOKEN,.LOCKERR) ; save board config -- LOCK
I $L(LOCKERR) D SAVERR^EDPX("collide",LOCKERR),LOADBRD(AREA,IEN) Q
;
F S X=$O(REQ(X)) Q:$E(X,1,4)'="col-" S WP(+$P(X,"-",2))=REQ(X,1)
D UPDBRD(AREA,.IEN,NAME,.WP,.MSG)
D SAVEU^EDPBLK(AREA,"board",.TOKEN) ; save board config -- UNLOCK
;
I $L(MSG) D SAVERR^EDPX("fail",MSG) Q
D UPDLAST(AREA) ; update last config save date
;
D XML^EDPX("<save status='ok' boardID='"_+IEN_"' />")
D LOADBRD(AREA,+IEN)
Q
UPDLAST(AREA) ; update last config save date
N FDA,FDAIEN,DIERR
S FDA(231.9,AREA_",",.03)=$$NOW^XLFDT
D FILE^DIE("","FDA","ERR")
D CLEAN^DILF
Q
UPDBRD(AREA,EDPIEN,NAME,SPEC,MSG) ; Add/Update a Spec
S MSG=""
S:'EDPIEN EDPIEN="+1" S EDPIEN=EDPIEN_","_AREA_","
;
N FDA,FDAIEN,DIERR,ERR
S FDA(231.94,EDPIEN,.01)=NAME
I $E(EDPIEN,1,2)="+1" D
. D UPDATE^DIE("","FDA","FDAIEN","ERR")
E D
. D FILE^DIE("","FDA","ERR")
I $D(DIERR) S MSG="save board name failed: "_$G(EDPIEN)
I '$D(DIERR) D
. I $E(EDPIEN,1,2)="+1" S EDPIEN=+FDAIEN(1)_","_AREA_","
. D WP^DIE(231.94,EDPIEN,1,"","SPEC")
. I $D(DIERR) S MSG="save board spec failed: "_$G(EDPIEN)
D CLEAN^DILF
Q
;bwf - 3/1/2013 removed below lines from column list per request from Dr. T
;;Patient X9999^@last4^Patient
;;Alerts^@alerts^Alerts
COLUMNS ;; Available Columns
;;Room / Bed^@bedNm^Room
;;Patient Name^@ptNm^Patient
;;Visit Created^@visit^Visit
;;Clinic^@clinicNm^Clinic
;;Complaint^@complaint^Complaint
;;Comment^@comment^Comment
;;Provider Initials^@mdNm^Prv
;;Resident Initials^@resNm^Res
;;Nurse Initials^@rnNm^RN
;;Acuity^@acuityNm^Acuity
;;Status^@statusNm^Status
;;Lab Active/Complete^@lab^L
;;Imaging Active/Complete^@rad^I
;;New (Unverified) Orders^@ordNew^New
;;Total Minutes^@emins^E Mins
;;Minutes at Location^@lmins^Mins
;;Disposition^@disposition^Disposition
;;Admittance Delay^@amins^Adm Delay
;;zzzzz
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBCF 4607 printed Nov 22, 2024@17:01:39 Page 2
EDPBCF ;SLC/KCM - Display Board Configuration ; 3/29/23 12:17pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,23**;Feb 24, 2012;Build 4
+2 ;
LOAD(AREA) ; Load General Configuration for an Area
+1 NEW I,NODE
+2 ;
+3 DO XML^EDPX("<colorMaps>")
+4 DO COLORS^EDPBCM
+5 DO XML^EDPX("</colorMaps>")
+6 ; load the color spec
DO LOAD^EDPBCM(AREA)
+7 ;
+8 ; load rooms/beds
DO LOAD^EDPBRM(AREA)
+9 ; load multi rooms
DO DFLTRM^EDPBRM(AREA)
+10 ;
+11 ; load parameters
DO LOAD^EDPBPM(AREA)
+12 ;
+13 ; load available columns
DO XML^EDPX("<columnList>")
+14 FOR I=1:1
SET NODE=$PIECE($TEXT(COLUMNS+I),";",3,99)
if $EXTRACT(NODE,1,5)="zzzzz"
QUIT
Begin DoDot:1
+15 NEW X
+16 SET X("label")=$PIECE(NODE,U)
+17 SET X("att")=$PIECE(NODE,U,2)
+18 SET X("header")=$PIECE(NODE,U,3)
+19 SET X("width")=50
+20 DO XML^EDPX($$XMLA^EDPX("col",.X))
End DoDot:1
+21 DO XML^EDPX("</columnList>")
+22 ;
+23 ; load 'display when' choices
DO CHOICES^EDPBRM
+24 ;
+25 NEW EDPSCRNS
DO GETLST^XPAR(.EDPSCRNS,"ALL","EDPF SCREEN SIZES","I")
+26 DO XML^EDPX("<screenSizes>")
+27 SET I=0
FOR
SET I=$ORDER(EDPSCRNS(I))
if 'I
QUIT
Begin DoDot:1
+28 SET EDPSCRNS(I)=$TRANSLATE(EDPSCRNS(I),"X","x")
+29 NEW X
+30 SET X("label")=EDPSCRNS(I)
+31 SET X("width")=$PIECE(EDPSCRNS(I),"x")
+32 SET X("height")=$PIECE(EDPSCRNS(I),"x",2)
+33 DO XML^EDPX($$XMLA^EDPX("size",.X))
End DoDot:1
+34 DO XML^EDPX("</screenSizes>")
+35 QUIT
LOADBRD(AREA,IEN) ; Load Named Board Spec
+1 NEW I,X,TOKEN
+2 if 'IEN
SET IEN=$ORDER(^EDPB(231.9,AREA,4,0))
if 'IEN
QUIT
+3 ;
+4 ; read lock the board config
DO READL^EDPBLK(AREA,"board",.TOKEN)
+5 ;Load Parameters *23
DO LOAD^EDPBPM(AREA)
+6 DO XML^EDPX("<boardToken>"_TOKEN_"</boardToken>")
+7 DO BRDLST(AREA)
+8 SET X("boardID")=IEN
SET X("boardName")=$PIECE(^EDPB(231.9,AREA,4,IEN,0),U)
+9 DO XML^EDPX($$XMLA^EDPX("spec",.X,""))
+10 SET I=0
FOR
SET I=$ORDER(^EDPB(231.9,AREA,4,IEN,1,I))
if 'I
QUIT
Begin DoDot:1
+11 DO XML^EDPX(^EDPB(231.9,AREA,4,IEN,1,I,0))
End DoDot:1
+12 DO XML^EDPX("</spec>")
+13 ; read unlock the board config
DO READU^EDPBLK(AREA,"board",.TOKEN)
+14 QUIT
BRDLST(AREA) ; List of boards
+1 NEW I,X
+2 DO XML^EDPX("<boards>")
+3 SET I=0
FOR
SET I=$ORDER(^EDPB(231.9,AREA,4,I))
if 'I
QUIT
Begin DoDot:1
+4 SET X=$PIECE(^EDPB(231.9,AREA,4,I,0),U)
+5 DO XML^EDPX($$XMLS^EDPX("board",I,X))
End DoDot:1
+6 DO XML^EDPX("</boards>")
+7 QUIT
SAVEBRD(REQ) ; Save Configuration
+1 NEW X,AREA,DFLTNM
+2 SET X="col-"
SET AREA=$GET(REQ("area",1))
SET DFLTNM="Main (default)"
+3 IF 'AREA
DO SAVERR^EDPX("fail","Missing area")
QUIT
+4 ;
+5 NEW NAME,IEN,WP,MSG
+6 SET NAME=$GET(REQ("boardName",1))
SET IEN=+$GET(REQ("boardID",1))
+7 IF (IEN>0)
IF ($PIECE(^EDPB(231.9,AREA,4,IEN,0),U)=DFLTNM)
IF (NAME'=DFLTNM)
Begin DoDot:1
+8 DO SAVERR^EDPX("fail","Default name may not be changed.")
End DoDot:1
QUIT
+9 IF NAME=""
Begin DoDot:1
+10 DO SAVERR^EDPX("fail","Missing name")
End DoDot:1
QUIT
+11 IF (IEN=0)
IF $ORDER(^EDPB(231.9,AREA,4,"B",NAME,0))
Begin DoDot:1
+12 DO SAVERR^EDPX("fail","Board name must be unique")
End DoDot:1
QUIT
+13 ;
+14 ; save XML spec as word processing
+15 NEW TOKEN,LOCKERR
+16 SET TOKEN=$GET(REQ("boardToken",1))
+17 ; save board config -- LOCK
DO SAVEL^EDPBLK(AREA,"board",.TOKEN,.LOCKERR)
+18 IF $LENGTH(LOCKERR)
DO SAVERR^EDPX("collide",LOCKERR)
DO LOADBRD(AREA,IEN)
QUIT
+19 ;
+20 FOR
SET X=$ORDER(REQ(X))
if $EXTRACT(X,1,4)'="col-"
QUIT
SET WP(+$PIECE(X,"-",2))=REQ(X,1)
+21 DO UPDBRD(AREA,.IEN,NAME,.WP,.MSG)
+22 ; save board config -- UNLOCK
DO SAVEU^EDPBLK(AREA,"board",.TOKEN)
+23 ;
+24 IF $LENGTH(MSG)
DO SAVERR^EDPX("fail",MSG)
QUIT
+25 ; update last config save date
DO UPDLAST(AREA)
+26 ;
+27 DO XML^EDPX("<save status='ok' boardID='"_+IEN_"' />")
+28 DO LOADBRD(AREA,+IEN)
+29 QUIT
UPDLAST(AREA) ; update last config save date
+1 NEW FDA,FDAIEN,DIERR
+2 SET FDA(231.9,AREA_",",.03)=$$NOW^XLFDT
+3 DO FILE^DIE("","FDA","ERR")
+4 DO CLEAN^DILF
+5 QUIT
UPDBRD(AREA,EDPIEN,NAME,SPEC,MSG) ; Add/Update a Spec
+1 SET MSG=""
+2 if 'EDPIEN
SET EDPIEN="+1"
SET EDPIEN=EDPIEN_","_AREA_","
+3 ;
+4 NEW FDA,FDAIEN,DIERR,ERR
+5 SET FDA(231.94,EDPIEN,.01)=NAME
+6 IF $EXTRACT(EDPIEN,1,2)="+1"
Begin DoDot:1
+7 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 DO FILE^DIE("","FDA","ERR")
End DoDot:1
+10 IF $DATA(DIERR)
SET MSG="save board name failed: "_$GET(EDPIEN)
+11 IF '$DATA(DIERR)
Begin DoDot:1
+12 IF $EXTRACT(EDPIEN,1,2)="+1"
SET EDPIEN=+FDAIEN(1)_","_AREA_","
+13 DO WP^DIE(231.94,EDPIEN,1,"","SPEC")
+14 IF $DATA(DIERR)
SET MSG="save board spec failed: "_$GET(EDPIEN)
End DoDot:1
+15 DO CLEAN^DILF
+16 QUIT
+17 ;bwf - 3/1/2013 removed below lines from column list per request from Dr. T
+18 ;;Patient X9999^@last4^Patient
+19 ;;Alerts^@alerts^Alerts
COLUMNS ;; Available Columns
+1 ;;Room / Bed^@bedNm^Room
+2 ;;Patient Name^@ptNm^Patient
+3 ;;Visit Created^@visit^Visit
+4 ;;Clinic^@clinicNm^Clinic
+5 ;;Complaint^@complaint^Complaint
+6 ;;Comment^@comment^Comment
+7 ;;Provider Initials^@mdNm^Prv
+8 ;;Resident Initials^@resNm^Res
+9 ;;Nurse Initials^@rnNm^RN
+10 ;;Acuity^@acuityNm^Acuity
+11 ;;Status^@statusNm^Status
+12 ;;Lab Active/Complete^@lab^L
+13 ;;Imaging Active/Complete^@rad^I
+14 ;;New (Unverified) Orders^@ordNew^New
+15 ;;Total Minutes^@emins^E Mins
+16 ;;Minutes at Location^@lmins^Mins
+17 ;;Disposition^@disposition^Disposition
+18 ;;Admittance Delay^@amins^Adm Delay
+19 ;;zzzzz