EDPCONV1 ;SLC/MKB - Convert local ED configuration ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
CONFIG(OLD) ; -- Save local OLD(NODE) configuration into ^EDPB(231.9)
N EDPSITE,TZDIFF,EDPAREA,X,X2,X3,X5,Y,NODE
S EDPSITE=$G(OLD("SITE")),X=$G(OLD("TZ")),TZDIFF=0 ;$$TZONE(X)
S EDPAREA=+$O(^EDPB(231.9,"C",EDPSITE,0)) Q:EDPAREA<1
S X2=$G(OLD(2)),X3=$G(OLD(3)),X5=$G(OLD(5))
; update entry
S:$L(TZDIFF) $P(^EDPB(231.9,EDPAREA,0),U,3)=TZDIFF
S NODE=$G(^EDPB(231.9,EDPAREA,1))
S X=$P(X5,U,1) S:$L(X) $P(NODE,U,1)=X ;Dx Reqd
S X=$P(X5,U,4) S:$L(X) $P(NODE,U,3)=X ;Disp Reqd
S X=$P(X5,U,5) S:$L(X) $P(NODE,U,4)=X ;Delay Reqd
S X=$P(X5,U,6) S:$L(X) $P(NODE,U,5)=X ;Delay Minutes
S X=$P(X2,U,4) I $L(X) D
. S Y=(+$P(X,":")*60)+$P(X,":",2) ;HH:MM -> minutes since Midnight
. S $P(NODE,U,6)=Y ;First Shift Start
S X=$P(X2,U,5) I X D
. S Y=X*60 ;hours -> minutes
. S $P(NODE,U,7)=Y ;Shift Duration
S ^EDPB(231.9,EDPAREA,1)=NODE
C1 ; Color Spec
N CSPEC,N,I,BACK,FONT
S CSPEC(1,0)="<colors id=""stsAcuity"" type=""val"" >",N=1
S I="STS" F S I=$O(OLD(I)) Q:I'?1"STS"1.N D
. S NODE=$G(OLD(I)),FONT=$P(NODE,U,2),BACK=$P(NODE,U,3)
. S X="<map att=""@status"" clr=""",Y=$$STS^EDPCONV(+$P(I,"STS",2))
. I '$L(FONT)!'$L(BACK) S X=X_"0"" val="""_Y_""" />"
. E S X=X_"1,"_$$CLR(BACK)_","_$$CLR(FONT)_""" val="""_Y_""" />"
. S N=N+1,CSPEC(N,0)=X
S I="ACU" F S I=$O(OLD(I)) Q:I'?1"ACU"1.N D
. S NODE=$G(OLD(I)),FONT=$$CLR($P(NODE,U,3)),BACK=$$CLR($P(NODE,U,4))
. S X="<map att=""@acuity"" clr=""",Y=$$ACU^EDPCONV(+$P(I,"ACU",2))
. I '$L(FONT)!'$L(BACK) S X=X_"0"" val="""_Y_""" />"
. E S X=X_"1,"_BACK_","_FONT_""" val="""_Y_""" />"
. S N=N+1,CSPEC(N,0)=X
S N=N+1,CSPEC(N,0)="</colors>"
F I=1:1 S X=$P($T(ORDCLR+I),";",3) Q:X="ZZZZ" S N=N+1,CSPEC(N,0)=X
S CSPEC(0)="^^"_N_U_N_U_DT
K ^EDPB(231.9,EDPAREA,3) M ^(3)=CSPEC
Q
;
CLR(X) ; -- Return code for color X
I X="CLRED" Q "0xff0000"
I X="CLBLUE" Q "0x0000ff"
I X="CLGREEN" Q "0x00ff00"
I X="CLYELLOW" Q "0xffff00"
I X="CLWHITE" Q "0xffffff"
I X="CLBLACK" Q "0x000000"
I X="CLNAVY" Q "0x000088"
I X="CLFUCHSIA" Q "0xff00ff"
I X="CLMONEYGREEN" Q "0xc0dcc0"
I X="CLSKYBLUE" Q "0xa6caf0"
I X="CLCREAM" Q "0xfffbf0"
I X="CLMAROON" Q "0x880000"
I X="CLTEAL" Q "0x008888"
I X="CLOLIVE" Q "0x888800"
Q ""
;
ORDCLR ; -- default color scheme for order urgencies
;;<colors id="labUrg" nm="Urgency - Lab" type="val" >
;;<map att="@labUrg" clr="1,0x000000,0x00ff00" val="0" />
;;<map att="@labUrg" clr="1,0x000000,0xffff00" val="1" />
;;<map att="@labUrg" clr="1,0x000000,0xff0000" val="2" />
;;</colors>
;;<colors id="radUrg" nm="Urgency - Radiology" type="val" >
;;<map att="@radUrg" clr="1,0x000000,0x00ff00" val="0" />
;;<map att="@radUrg" clr="1,0x000000,0xffff00" val="1" />
;;<map att="@radUrg" clr="1,0x000000,0xff0000" val="2" />
;;</colors>
;;ZZZZ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPCONV1 3012 printed Dec 13, 2024@01:51:42 Page 2
EDPCONV1 ;SLC/MKB - Convert local ED configuration ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
CONFIG(OLD) ; -- Save local OLD(NODE) configuration into ^EDPB(231.9)
+1 NEW EDPSITE,TZDIFF,EDPAREA,X,X2,X3,X5,Y,NODE
+2 ;$$TZONE(X)
SET EDPSITE=$GET(OLD("SITE"))
SET X=$GET(OLD("TZ"))
SET TZDIFF=0
+3 SET EDPAREA=+$ORDER(^EDPB(231.9,"C",EDPSITE,0))
if EDPAREA<1
QUIT
+4 SET X2=$GET(OLD(2))
SET X3=$GET(OLD(3))
SET X5=$GET(OLD(5))
+5 ; update entry
+6 if $LENGTH(TZDIFF)
SET $PIECE(^EDPB(231.9,EDPAREA,0),U,3)=TZDIFF
+7 SET NODE=$GET(^EDPB(231.9,EDPAREA,1))
+8 ;Dx Reqd
SET X=$PIECE(X5,U,1)
if $LENGTH(X)
SET $PIECE(NODE,U,1)=X
+9 ;Disp Reqd
SET X=$PIECE(X5,U,4)
if $LENGTH(X)
SET $PIECE(NODE,U,3)=X
+10 ;Delay Reqd
SET X=$PIECE(X5,U,5)
if $LENGTH(X)
SET $PIECE(NODE,U,4)=X
+11 ;Delay Minutes
SET X=$PIECE(X5,U,6)
if $LENGTH(X)
SET $PIECE(NODE,U,5)=X
+12 SET X=$PIECE(X2,U,4)
IF $LENGTH(X)
Begin DoDot:1
+13 ;HH:MM -> minutes since Midnight
SET Y=(+$PIECE(X,":")*60)+$PIECE(X,":",2)
+14 ;First Shift Start
SET $PIECE(NODE,U,6)=Y
End DoDot:1
+15 SET X=$PIECE(X2,U,5)
IF X
Begin DoDot:1
+16 ;hours -> minutes
SET Y=X*60
+17 ;Shift Duration
SET $PIECE(NODE,U,7)=Y
End DoDot:1
+18 SET ^EDPB(231.9,EDPAREA,1)=NODE
C1 ; Color Spec
+1 NEW CSPEC,N,I,BACK,FONT
+2 SET CSPEC(1,0)="<colors id=""stsAcuity"" type=""val"" >"
SET N=1
+3 SET I="STS"
FOR
SET I=$ORDER(OLD(I))
if I'?1"STS"1.N
QUIT
Begin DoDot:1
+4 SET NODE=$GET(OLD(I))
SET FONT=$PIECE(NODE,U,2)
SET BACK=$PIECE(NODE,U,3)
+5 SET X="<map att=""@status"" clr="""
SET Y=$$STS^EDPCONV(+$PIECE(I,"STS",2))
+6 IF '$LENGTH(FONT)!'$LENGTH(BACK)
SET X=X_"0"" val="""_Y_""" />"
+7 IF '$TEST
SET X=X_"1,"_$$CLR(BACK)_","_$$CLR(FONT)_""" val="""_Y_""" />"
+8 SET N=N+1
SET CSPEC(N,0)=X
End DoDot:1
+9 SET I="ACU"
FOR
SET I=$ORDER(OLD(I))
if I'?1"ACU"1.N
QUIT
Begin DoDot:1
+10 SET NODE=$GET(OLD(I))
SET FONT=$$CLR($PIECE(NODE,U,3))
SET BACK=$$CLR($PIECE(NODE,U,4))
+11 SET X="<map att=""@acuity"" clr="""
SET Y=$$ACU^EDPCONV(+$PIECE(I,"ACU",2))
+12 IF '$LENGTH(FONT)!'$LENGTH(BACK)
SET X=X_"0"" val="""_Y_""" />"
+13 IF '$TEST
SET X=X_"1,"_BACK_","_FONT_""" val="""_Y_""" />"
+14 SET N=N+1
SET CSPEC(N,0)=X
End DoDot:1
+15 SET N=N+1
SET CSPEC(N,0)="</colors>"
+16 FOR I=1:1
SET X=$PIECE($TEXT(ORDCLR+I),";",3)
if X="ZZZZ"
QUIT
SET N=N+1
SET CSPEC(N,0)=X
+17 SET CSPEC(0)="^^"_N_U_N_U_DT
+18 KILL ^EDPB(231.9,EDPAREA,3)
MERGE ^(3)=CSPEC
+19 QUIT
+20 ;
CLR(X) ; -- Return code for color X
+1 IF X="CLRED"
QUIT "0xff0000"
+2 IF X="CLBLUE"
QUIT "0x0000ff"
+3 IF X="CLGREEN"
QUIT "0x00ff00"
+4 IF X="CLYELLOW"
QUIT "0xffff00"
+5 IF X="CLWHITE"
QUIT "0xffffff"
+6 IF X="CLBLACK"
QUIT "0x000000"
+7 IF X="CLNAVY"
QUIT "0x000088"
+8 IF X="CLFUCHSIA"
QUIT "0xff00ff"
+9 IF X="CLMONEYGREEN"
QUIT "0xc0dcc0"
+10 IF X="CLSKYBLUE"
QUIT "0xa6caf0"
+11 IF X="CLCREAM"
QUIT "0xfffbf0"
+12 IF X="CLMAROON"
QUIT "0x880000"
+13 IF X="CLTEAL"
QUIT "0x008888"
+14 IF X="CLOLIVE"
QUIT "0x888800"
+15 QUIT ""
+16 ;
ORDCLR ; -- default color scheme for order urgencies
+1 ;;<colors id="labUrg" nm="Urgency - Lab" type="val" >
+2 ;;<map att="@labUrg" clr="1,0x000000,0x00ff00" val="0" />
+3 ;;<map att="@labUrg" clr="1,0x000000,0xffff00" val="1" />
+4 ;;<map att="@labUrg" clr="1,0x000000,0xff0000" val="2" />
+5 ;;</colors>
+6 ;;<colors id="radUrg" nm="Urgency - Radiology" type="val" >
+7 ;;<map att="@radUrg" clr="1,0x000000,0x00ff00" val="0" />
+8 ;;<map att="@radUrg" clr="1,0x000000,0xffff00" val="1" />
+9 ;;<map att="@radUrg" clr="1,0x000000,0xff0000" val="2" />
+10 ;;</colors>
+11 ;;ZZZZ
+12 QUIT
