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