EDPBCM ;SLC/KCM - Available color maps ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
LOAD(AREA) ; Load Color Spec
N I,TOKEN
;
D READL^EDPBLK(AREA,"color",.TOKEN) ; read color config -- LOCK
D XML^EDPX("<colorToken>"_TOKEN_"</colorToken>")
D XML^EDPX("<colorSpec>")
S I=0 F S I=$O(^EDPB(231.9,AREA,3,I)) Q:'I D
. D XML^EDPX(^EDPB(231.9,AREA,3,I,0))
D XML^EDPX("</colorSpec>")
D READU^EDPBLK(AREA,"color",.TOKEN) ; read color config -- UNLOCK
Q
SAVE(REQ) ; Save Configuration
N X,WP,AREA,TOKEN,LOCKERR,DIERR
S X="xml-",AREA=$G(REQ("area",1))
I 'AREA D SAVERR^EDPX("fail","Missing area") Q
;
S TOKEN=$G(REQ("colorToken",1))
D SAVEL^EDPBLK(AREA,"color",.TOKEN,.LOCKERR) ; save color config -- LOCK
I $L(LOCKERR) D SAVERR^EDPX("collide",LOCKERR),LOAD(AREA) Q
;
F S X=$O(REQ(X)) Q:$E(X,1,4)'="xml-" S WP(+$P(X,"-",2))=REQ(X,1)
D WP^DIE(231.9,AREA_",",3,"","WP")
D SAVEU^EDPBLK(AREA,"color",.TOKEN) ; save color config -- UNLOCK
;
I $D(DIERR) D SAVERR^EDPX("fail","save failed") Q
D XML^EDPX("<save status='ok' />")
D LOAD(AREA) ; return updated list of colors
D UPDLAST^EDPBCF(AREA) ; update last config date
Q
COLORS ;; Available Color Maps
D ENMAP("none"," ","none") ; for no selection
;
D ENMAP("stsAcuity","Status / Acuity","val")
D CODES("status"),CODES("acuity"),EXMAP
;
D ENMAP("status","Status","val")
D CODES("status"),EXMAP
;
D ENMAP("acuity","Acuity","val")
D CODES("acuity"),EXMAP
;
D ENMAP("bed","Room / Bed","bed")
D ENMAP("md","Provider","staff")
D ENMAP("res","Resident","staff")
D ENMAP("rn","Nurse","staff")
;
D ENMAP("labUrg","Urgency - Lab","val")
D URG("labUrg"),EXMAP
;D ENMAP("medUrg","Urgency - Medications","val")
;D URG("medUrg"),EXMAP
D ENMAP("radUrg","Urgency - Radiology","val")
D URG("radUrg"),EXMAP
;
D ENMAP("emins","Total Elapsed Minutes","rng")
D ENMAP("lmins","Minutes at Location","rng")
D ENMAP("minLab","Minutes for Lab Order","rng")
;D ENMAP("minMed","Minutes for Medication Order","rng")
D ENMAP("minRad","Minutes for Imaging Order","rng")
D ENMAP("minVer","Minutes for Unverified Order","rng")
Q
ENMAP(ID,NM,TYP) ; create element for colormap
N X,END
S END="/" S:TYP="val" END=""
S X("id")=ID
S X("nm")=NM
S X("type")=TYP
D XML^EDPX($$XMLA^EDPX("colors",.X,END))
Q
EXMAP ; create closing tag
D XML^EDPX("</colors>")
Q
CODES(NM) ; create map elements for a set of codes
N CODESET,IEN
; bwf - placed $G around EDPSTA to pervent undefined - commented original line below
S CODESET=$G(EDPSTA)_"."_NM
;S CODESET=EDPSTA_"."_NM
; bwf - end changes
I '$D(^EDPB(233.2,"B",CODESET)) S CODESET="edp."_NM
S IEN=$O(^EDPB(233.2,"B",CODESET,0))
Q:'IEN
;
N SEQ,CODE,DA
S SEQ=0 F S SEQ=$O(^EDPB(233.2,IEN,1,"B",SEQ)) Q:'SEQ D
. S DA=0 F S DA=$O(^EDPB(233.2,IEN,1,"B",SEQ,DA)) Q:'DA D
. . S CODE=$P(^EDPB(233.2,IEN,1,DA,0),U,2)
. . Q:'CODE
. . D MAP(NM,CODE,$P(^EDPB(233.1,CODE,0),U,2))
Q
URG(ATT) ; create map elements for standard urgencies
D MAP(ATT,0,"No Orders")
D MAP(ATT,1,"Active Orders")
D MAP(ATT,2,"STAT Orders")
Q
MAP(ATT,VAL,NM) ; create a single map element
N X
S X("att")="@"_ATT
S X("val")=VAL
S X("nm")=NM
S X("clr")=0
D XML^EDPX($$XMLA^EDPX("map",.X))
Q
LIST ; Build selection list for color maps -- OBSOLETE?
N I,X
F I=1:1 S X=$P($T(MAPLST+I),";",3,99) Q:$E(X,1,5)="zzzzz" D
. S X("data")=$P(X,U,1),X("label")=$P(X,U,2)
. D XML^EDPX($$XMLA^EDPX("colors",.X))
Q
MAPLST ; list of available color maps
;;^ ^
;;stsAcuity^Status / Acuity
;;status^Status
;;acuity^Acuity
;;bed^Room / Bed
;;staff^Staff
;;labUrg^Urgency - Lab
;;radUrg^Urgency - Imaging
;;emins^Total Minutes
;;lmins^Minutes at Location
;;minLab^Minutes for Lab Order
;;minRad^Minutes for Imaging Order
;;minVer^Minutes for Unverified Order
;;zzzzz
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBCM 3930 printed Apr 09, 2024@20:56:55 Page 2
EDPBCM ;SLC/KCM - Available color maps ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
LOAD(AREA) ; Load Color Spec
+1 NEW I,TOKEN
+2 ;
+3 ; read color config -- LOCK
DO READL^EDPBLK(AREA,"color",.TOKEN)
+4 DO XML^EDPX("<colorToken>"_TOKEN_"</colorToken>")
+5 DO XML^EDPX("<colorSpec>")
+6 SET I=0
FOR
SET I=$ORDER(^EDPB(231.9,AREA,3,I))
if 'I
QUIT
Begin DoDot:1
+7 DO XML^EDPX(^EDPB(231.9,AREA,3,I,0))
End DoDot:1
+8 DO XML^EDPX("</colorSpec>")
+9 ; read color config -- UNLOCK
DO READU^EDPBLK(AREA,"color",.TOKEN)
+10 QUIT
SAVE(REQ) ; Save Configuration
+1 NEW X,WP,AREA,TOKEN,LOCKERR,DIERR
+2 SET X="xml-"
SET AREA=$GET(REQ("area",1))
+3 IF 'AREA
DO SAVERR^EDPX("fail","Missing area")
QUIT
+4 ;
+5 SET TOKEN=$GET(REQ("colorToken",1))
+6 ; save color config -- LOCK
DO SAVEL^EDPBLK(AREA,"color",.TOKEN,.LOCKERR)
+7 IF $LENGTH(LOCKERR)
DO SAVERR^EDPX("collide",LOCKERR)
DO LOAD(AREA)
QUIT
+8 ;
+9 FOR
SET X=$ORDER(REQ(X))
if $EXTRACT(X,1,4)'="xml-"
QUIT
SET WP(+$PIECE(X,"-",2))=REQ(X,1)
+10 DO WP^DIE(231.9,AREA_",",3,"","WP")
+11 ; save color config -- UNLOCK
DO SAVEU^EDPBLK(AREA,"color",.TOKEN)
+12 ;
+13 IF $DATA(DIERR)
DO SAVERR^EDPX("fail","save failed")
QUIT
+14 DO XML^EDPX("<save status='ok' />")
+15 ; return updated list of colors
DO LOAD(AREA)
+16 ; update last config date
DO UPDLAST^EDPBCF(AREA)
+17 QUIT
COLORS ;; Available Color Maps
+1 ; for no selection
DO ENMAP("none"," ","none")
+2 ;
+3 DO ENMAP("stsAcuity","Status / Acuity","val")
+4 DO CODES("status")
DO CODES("acuity")
DO EXMAP
+5 ;
+6 DO ENMAP("status","Status","val")
+7 DO CODES("status")
DO EXMAP
+8 ;
+9 DO ENMAP("acuity","Acuity","val")
+10 DO CODES("acuity")
DO EXMAP
+11 ;
+12 DO ENMAP("bed","Room / Bed","bed")
+13 DO ENMAP("md","Provider","staff")
+14 DO ENMAP("res","Resident","staff")
+15 DO ENMAP("rn","Nurse","staff")
+16 ;
+17 DO ENMAP("labUrg","Urgency - Lab","val")
+18 DO URG("labUrg")
DO EXMAP
+19 ;D ENMAP("medUrg","Urgency - Medications","val")
+20 ;D URG("medUrg"),EXMAP
+21 DO ENMAP("radUrg","Urgency - Radiology","val")
+22 DO URG("radUrg")
DO EXMAP
+23 ;
+24 DO ENMAP("emins","Total Elapsed Minutes","rng")
+25 DO ENMAP("lmins","Minutes at Location","rng")
+26 DO ENMAP("minLab","Minutes for Lab Order","rng")
+27 ;D ENMAP("minMed","Minutes for Medication Order","rng")
+28 DO ENMAP("minRad","Minutes for Imaging Order","rng")
+29 DO ENMAP("minVer","Minutes for Unverified Order","rng")
+30 QUIT
ENMAP(ID,NM,TYP) ; create element for colormap
+1 NEW X,END
+2 SET END="/"
if TYP="val"
SET END=""
+3 SET X("id")=ID
+4 SET X("nm")=NM
+5 SET X("type")=TYP
+6 DO XML^EDPX($$XMLA^EDPX("colors",.X,END))
+7 QUIT
EXMAP ; create closing tag
+1 DO XML^EDPX("</colors>")
+2 QUIT
CODES(NM) ; create map elements for a set of codes
+1 NEW CODESET,IEN
+2 ; bwf - placed $G around EDPSTA to pervent undefined - commented original line below
+3 SET CODESET=$GET(EDPSTA)_"."_NM
+4 ;S CODESET=EDPSTA_"."_NM
+5 ; bwf - end changes
+6 IF '$DATA(^EDPB(233.2,"B",CODESET))
SET CODESET="edp."_NM
+7 SET IEN=$ORDER(^EDPB(233.2,"B",CODESET,0))
+8 if 'IEN
QUIT
+9 ;
+10 NEW SEQ,CODE,DA
+11 SET SEQ=0
FOR
SET SEQ=$ORDER(^EDPB(233.2,IEN,1,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+12 SET DA=0
FOR
SET DA=$ORDER(^EDPB(233.2,IEN,1,"B",SEQ,DA))
if 'DA
QUIT
Begin DoDot:2
+13 SET CODE=$PIECE(^EDPB(233.2,IEN,1,DA,0),U,2)
+14 if 'CODE
QUIT
+15 DO MAP(NM,CODE,$PIECE(^EDPB(233.1,CODE,0),U,2))
End DoDot:2
End DoDot:1
+16 QUIT
URG(ATT) ; create map elements for standard urgencies
+1 DO MAP(ATT,0,"No Orders")
+2 DO MAP(ATT,1,"Active Orders")
+3 DO MAP(ATT,2,"STAT Orders")
+4 QUIT
MAP(ATT,VAL,NM) ; create a single map element
+1 NEW X
+2 SET X("att")="@"_ATT
+3 SET X("val")=VAL
+4 SET X("nm")=NM
+5 SET X("clr")=0
+6 DO XML^EDPX($$XMLA^EDPX("map",.X))
+7 QUIT
LIST ; Build selection list for color maps -- OBSOLETE?
+1 NEW I,X
+2 FOR I=1:1
SET X=$PIECE($TEXT(MAPLST+I),";",3,99)
if $EXTRACT(X,1,5)="zzzzz"
QUIT
Begin DoDot:1
+3 SET X("data")=$PIECE(X,U,1)
SET X("label")=$PIECE(X,U,2)
+4 DO XML^EDPX($$XMLA^EDPX("colors",.X))
End DoDot:1
+5 QUIT
MAPLST ; list of available color maps
+1 ;;^ ^
+2 ;;stsAcuity^Status / Acuity
+3 ;;status^Status
+4 ;;acuity^Acuity
+5 ;;bed^Room / Bed
+6 ;;staff^Staff
+7 ;;labUrg^Urgency - Lab
+8 ;;radUrg^Urgency - Imaging
+9 ;;emins^Total Minutes
+10 ;;lmins^Minutes at Location
+11 ;;minLab^Minutes for Lab Order
+12 ;;minRad^Minutes for Imaging Order
+13 ;;minVer^Minutes for Unverified Order
+14 ;;zzzzz
