Routine: EDPCONV1

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPCONV1   3012     printed  Mar 13, 2025@20:56:24                                                                                                                                                                                                    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

EDPCONV1.m