EDPQPPS ;SLC/KCM - Display Board Specs ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
GET(AREA,BOARD) ; Get Display Board Specs
;N I S I=0
;F S I=$O(^EDPB(231.9,AREA,2,I)) Q:'I D XML^EDPX(^EDPB(231.9,AREA,2,I,0))
N ROLEIEN,R0,RNAME,RABBR,RXML
I '$L($G(BOARD)) S BOARD="Main (default)"
S BOARD=$O(^EDPB(231.9,AREA,4,"B",BOARD,0))
D LOADBRD^EDPBCF(AREA,BOARD)
;
D XML^EDPX("<colorSpec>")
D CLRBED(AREA)
;D CLRSTAFF(AREA,"md","P")
;D CLRSTAFF(AREA,"res","R")
;D CLRSTAFF(AREA,"rn","N")
S ROLEIEN=0 F S ROLEIEN=$O(^EDPB(232.5,ROLEIEN)) Q:'ROLEIEN D
.S R0=$G(^EDPB(232.5,ROLEIEN,0)),RNAME=$P(R0,U),RABBR=$P(R0,U,2),RXML=$P(R0,U,3)
.D CLRSTAFF(AREA,RXML,ROLEIEN)
N I S I=0
F S I=$O(^EDPB(231.9,AREA,3,I)) Q:'I D XML^EDPX(^EDPB(231.9,AREA,3,I,0))
D XML^EDPX("</colorSpec>")
Q
CLRBED(AREA) ; add bed colors
D XML^EDPX("<colors id='bed' type='bed' >")
N BED,X0
S BED=0 F S BED=$O(^EDPB(231.8,"C",EDPSITE,AREA,BED)) Q:'BED D
. S X0=^EDPB(231.8,BED,0)
. I $P(X0,U,12)="" Q
. N X
. S X("att")="@bed"
. S X("clr")=$P(X0,U,12)
. S X("val")=BED
. D XML^EDPX($$XMLA^EDPX("map",.X))
D XML^EDPX("</colors>")
Q
CLRSTAFF(AREA,ROLEID,ROLEIEN) ; add staff colors
D XML^EDPX("<colors id='"_ROLEID_"' type='staff' >")
N IEN,X0
S IEN="" F S IEN=$O(^EDPB(231.7,"AC",EDPSITE,AREA,ROLEIEN,IEN)) Q:'IEN D
. S X0=^EDPB(231.7,IEN,0) Q:'$P(X0,U,8)
. N X
. S X("att")=$S(ROLEID'="":ROLEID,1:"nop")
. ;S X("att")=$S(ROLE="P":"@md",ROLE="N":"@rn",ROLE="R":"@res",1:"nop")
. S X("clr")=$P(X0,U,8)
. S X("val")=$P(X0,U)
. D XML^EDPX($$XMLA^EDPX("map",.X))
D XML^EDPX("</colors>")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQPPS 1677 printed Sep 15, 2024@21:16:27 Page 2
EDPQPPS ;SLC/KCM - Display Board Specs ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
GET(AREA,BOARD) ; Get Display Board Specs
+1 ;N I S I=0
+2 ;F S I=$O(^EDPB(231.9,AREA,2,I)) Q:'I D XML^EDPX(^EDPB(231.9,AREA,2,I,0))
+3 NEW ROLEIEN,R0,RNAME,RABBR,RXML
+4 IF '$LENGTH($GET(BOARD))
SET BOARD="Main (default)"
+5 SET BOARD=$ORDER(^EDPB(231.9,AREA,4,"B",BOARD,0))
+6 DO LOADBRD^EDPBCF(AREA,BOARD)
+7 ;
+8 DO XML^EDPX("<colorSpec>")
+9 DO CLRBED(AREA)
+10 ;D CLRSTAFF(AREA,"md","P")
+11 ;D CLRSTAFF(AREA,"res","R")
+12 ;D CLRSTAFF(AREA,"rn","N")
+13 SET ROLEIEN=0
FOR
SET ROLEIEN=$ORDER(^EDPB(232.5,ROLEIEN))
if 'ROLEIEN
QUIT
Begin DoDot:1
+14 SET R0=$GET(^EDPB(232.5,ROLEIEN,0))
SET RNAME=$PIECE(R0,U)
SET RABBR=$PIECE(R0,U,2)
SET RXML=$PIECE(R0,U,3)
+15 DO CLRSTAFF(AREA,RXML,ROLEIEN)
End DoDot:1
+16 NEW I
SET I=0
+17 FOR
SET I=$ORDER(^EDPB(231.9,AREA,3,I))
if 'I
QUIT
DO XML^EDPX(^EDPB(231.9,AREA,3,I,0))
+18 DO XML^EDPX("</colorSpec>")
+19 QUIT
CLRBED(AREA) ; add bed colors
+1 DO XML^EDPX("<colors id='bed' type='bed' >")
+2 NEW BED,X0
+3 SET BED=0
FOR
SET BED=$ORDER(^EDPB(231.8,"C",EDPSITE,AREA,BED))
if 'BED
QUIT
Begin DoDot:1
+4 SET X0=^EDPB(231.8,BED,0)
+5 IF $PIECE(X0,U,12)=""
QUIT
+6 NEW X
+7 SET X("att")="@bed"
+8 SET X("clr")=$PIECE(X0,U,12)
+9 SET X("val")=BED
+10 DO XML^EDPX($$XMLA^EDPX("map",.X))
End DoDot:1
+11 DO XML^EDPX("</colors>")
+12 QUIT
CLRSTAFF(AREA,ROLEID,ROLEIEN) ; add staff colors
+1 DO XML^EDPX("<colors id='"_ROLEID_"' type='staff' >")
+2 NEW IEN,X0
+3 SET IEN=""
FOR
SET IEN=$ORDER(^EDPB(231.7,"AC",EDPSITE,AREA,ROLEIEN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET X0=^EDPB(231.7,IEN,0)
if '$PIECE(X0,U,8)
QUIT
+5 NEW X
+6 SET X("att")=$SELECT(ROLEID'="":ROLEID,1:"nop")
+7 ;S X("att")=$S(ROLE="P":"@md",ROLE="N":"@rn",ROLE="R":"@res",1:"nop")
+8 SET X("clr")=$PIECE(X0,U,8)
+9 SET X("val")=$PIECE(X0,U)
+10 DO XML^EDPX($$XMLA^EDPX("map",.X))
End DoDot:1
+11 DO XML^EDPX("</colors>")
+12 QUIT
