EDPCONV.m

EDPCONV ;SLC/MKB - Process incoming mail to convert local ED Visits ;2/28/12 08:33am

 ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23

 ;

AREA(DIV) ; -- Return #231.9 ien for DIVision (#4 ien)

 Q +$O(^EDPB(231.9,"C",DIV,0))

 ;

VST(OLD) ; -- Copy OLD(node) ER visit entry into ^EDP(230)

 N X,I,EDPY,EDPSITE,EDPDIFF,EDPAREA,EDPSTA,EDPLOG,EDPI,PNM,SSN

 S EDPSITE=$G(OLD("SITE")),X=$G(OLD("TZ")),EDPDIFF=0 ;$$TZONE(X)

 S EDPAREA=$$AREA(EDPSITE) Q:EDPAREA<1

 S EDPSTA=$$STA^XUAF4(EDPSITE)            ;station number

 F I=0,1,2,3,4,6,9 S OLD(I)=$G(OLD(I))    ;defined

 S X=$P(OLD(0),U,5),EDPY=$$NEW(230,X) Q:EDPY<1

 S PNM=$P(OLD(0),U),SSN=$P(OLD(0),U,3)    ;patient name, ssn

 S EDPLOG(0)=X_U_EDPSITE_U_EDPAREA_U_PNM_U_SSN_U_$P(OLD(6),U,2)_U_$G(OLD("CLOSED"))_U_$P(OLD(4),U,4,5)_U_$$ARR($P(OLD(0),U,6))_U_$$PID(PNM,SSN) ;_U_EDPDIFF

 S X=$P(OLD(9),U,3) S:'X X=$P(OLD(6),U,3) ;disposition

 S EDPLOG(1)=$P(OLD(1),U)_U_$$DISP(X)_U_$P(OLD(9),U,2)_U_$P(OLD(9),U)_U_$$DEL($P(OLD(4),U,7))

 S X=$P(OLD(2),U) S:$L(X) EDPLOG(2)=X

 S EDPLOG(3)=U_$$STS($P(OLD(0),U,4))_U_$$ACU($P(OLD(4),U,3))_U_$$LOC($P(OLD(3),U,2))_U_$P(OLD(4),U)_U_$P(OLD(4),U,2)_U_$P(OLD(4),U,6)_U_$P(OLD(6),U)

 I $D(OLD(8)) M EDPLOG(4)=OLD(8) S $P(EDPLOG(4,0),U,2)="230.04A" D

 . S EDPI=0 F  S EDPI=$O(EDPLOG(4,EDPI)) Q:EDPI<1  D

 .. S X=$P($G(EDPLOG(4,EDPI,0)),U,2) Q:'$L(X)  ;code -> ien

 .. I X?1"ICD-9-CODE-".E S X=$P(X,"-",4)

 .. I X["/" S X=$P(X,"/")

 .. ;Begin EDP*2.0*2 CHANGES.

 .. S X=$$ICDDX^EDPLEX(X,$P($G(^EDP(230,EDPY,0),2781001),U,8)),$P(EDPLOG(4,EDPI,0),U,2)=$S(X>0:+X,1:"")

 .. ;End EDP*2.0*2 CHANGES.

 ; Save/Xref log entry

 M ^EDP(230,EDPY)=EDPLOG

 D XREF(230,EDPY)

 ;

 ; Set History from Movement nodes

 S EDPI="MVT" F  S EDPI=$O(OLD(EDPI)) Q:EDPI'?1"MVT"1.N  D HIST(EDPI,EDPY)

 ;

 ; Create Orders list for active visits

 I '$G(OLD("CLOSED")) S X=EDPLOG(0) D ORDERS(EDPY,X)

 ;

 S OLD(230)=EDPY ;return new ien

 Q

 ;

HIST(MVTI,LOG) ; -- Copy OLD(MVTI) into ^EDP(230.1)

 N EDPY,MVT,ACT

 S EDPY=$$NEW(230.1,LOG) Q:EDPY<1

 S MVT=OLD(MVTI)

 S ACT(0)=LOG_U_$P(MVT,U,2)_U_U_$P($G(^EDP(230,LOG,0)),U,4,6)

 S ACT(3)=U_$$STS($P(MVT,U,3))_U_$$ACU($P(MVT,U,4))_U_$$LOC($P(MVT,U,5))_U_$P(MVT,U,6,8)

 ; Save/Xref history

 M ^EDP(230.1,EDPY)=ACT

 D XREF(230.1,EDPY)

 Q

 ;

NEW(FILE,X) ; -- Return ien of new entry in FILE

 N DO,DIC,DA,Y

 S DIC="^EDP("_FILE_",",DIC(0)="LF" D FILE^DICN

 Q +Y

 ;

XREF(FILE,DA) ; -- Set all xrefs for DA in FILE

 N DIK

 S DIK="^EDP("_FILE_"," D IX1^DIK

 Q

 ;

PID(NM,ID) ; -- Return brief id (L0000) for patient

 N Y S Y=$E(NM)_$E(ID,6,9)

 Q Y

 ;

TZONE(X) ; -- Return #minutes local offset for time zone

 N Y S Y=$E(X)_(60*$E(X,2,3)+$E(X,4,5))

 Q Y

 ;

ACU(X) ; -- Return[/add] #233.1 ien for Acuity X

 I $G(X)="" Q ""

 N Y,NODE S NODE=$G(OLD("ACU"_+X)) Q:NODE="" $$NOVALUE

 S X=$P(NODE,U,2),Y=""

 S:$L(X) Y=+$O(^EDPB(233.1,"AB","acuity",X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR,NM

 S NM=$P(NODE,U),NM=$S(NM["-":$P(NM,"-",2),1:NM)

 S FDA(233.1,"+1,",.01)=EDPSTA_".acuity."_$$LOW^XLFSTR(NM)

 S FDA(233.1,"+1,",.02)=X

 S FDA(233.1,"+1,",.03)=X

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

 Q Y

 ;

STS(X) ; -- Return[/add] #233.1 ien for Status X

 I $G(X)="" Q ""

 N Y,NODE

 S NODE=$G(OLD("STS"_+X)),Y="" Q:NODE="" $$NOVALUE

 S X=$P(NODE,U,1) S:$L(X) Y=+$O(^EDPB(233.1,"AC","status",X,0)) Q:Y Y

 S X=$P(NODE,U,4) S:$L(X) Y=+$O(^EDPB(233.1,"AB","status",X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR

 S FDA(233.1,"+1,",.01)=EDPSTA_".status."_$$LOW^XLFSTR(X)

 S FDA(233.1,"+1,",.02)=$P(NODE,U)           ;text

 S FDA(233.1,"+1,",.03)=X                    ;display/abbreviation

 S:$P(NODE,U,6)="Y" FDA(233.1,"+1,",.05)="A" ;admission flag

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

 Q Y

 ;

DEL(X) ; -- Return[/add] #233.1 ien for Delay Reason X

 I $G(X)="" Q ""

 N Y,NODE

 S NODE=$G(OLD("DEL"_+X)),Y="" Q:NODE="" $$NOVALUE

 S X=$P(NODE,U,1) S:$L(X) Y=+$O(^EDPB(233.1,"AC","delay",X,0)) Q:Y Y

 S X=$P(NODE,U,3) S:$L(X) Y=+$O(^EDPB(233.1,"AB","delay",X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR

 S FDA(233.1,"+1,",.01)=EDPSTA_".delay."_$$LOW^XLFSTR(X)

 S FDA(233.1,"+1,",.02)=$P(NODE,U)     ;name

 S FDA(233.1,"+1,",.03)=$P(NODE,U,3)   ;abbreviation

 S FDA(233.1,"+1,",.05)=$P(NODE,U,5)   ;report flag

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

 Q Y

 ;

ARR(X) ; -- Return[/add] #233.1 ien for Arrival Mode X

 I $G(X)="" Q ""

 N Y,NODE

 S NODE=$G(OLD("ARR"_+X)),Y="" Q:NODE="" $$NOVALUE

 S X=$P($P(NODE,U)," ") S:$L(X) Y=+$O(^EDPB(233.1,"AC","source",X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR

 S FDA(233.1,"+1,",.01)=EDPSTA_".source."_$$LOW^XLFSTR(X)

 S FDA(233.1,"+1,",.02)=X

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

 Q Y

 ;

DISP(X) ; -- Return[/add] #233.1 ien for Disposition code X

 I $G(X)="" Q ""

 N Y,NODE

 S NODE=$G(OLD("DIS"_X)),Y="" Q:NODE="" $$NOVALUE

 S:X X=$P(NODE,U,5) ;ien -> abbreviation

 I $L(X) S Y=+$O(^EDPB(233.1,"AB","disposition",X,0)) Q:Y Y

 E  S X=$P(NODE,U) S:$L(X) Y=+$O(^EDPB(233.1,"AC","disposition",X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR

 S X=$P($P(NODE,U)," ") ;1st word, for name

 S FDA(233.1,"+1,",.01)=EDPSTA_".disposition."_$$LOW^XLFSTR(X)

 S FDA(233.1,"+1,",.02)=$P(NODE,U)        ;Display Name

 S FDA(233.1,"+1,",.03)=$P(NODE,U,5)      ;Abbreviation

 S:$P(NODE,U,7) FDA(233.1,"+1,",.05)="M"  ;Missed Opportunity

 S:$P(NODE,U,6) FDA(233.1,"+1,",.05)="A"  ;Admission

 S:$P(NODE,U,8) FDA(233.1,"+1,",.05)="VA" ;VA Admission

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

 Q Y

 ;

LOC(X) ; -- Return[/add] #231.8 ien for Location X

 I $G(X)="" Q ""

 N Y,NODE

 S NODE=$G(OLD("LOC"_+X)) S:NODE="" NODE="UNKNOWN^UNK^^0^^^0"

 S X=$P(NODE,U,2),Y=""

 S:$L(X) Y=+$O(^EDPB(231.8,"AC",EDPSITE,EDPAREA,X,0)) Q:Y Y

 ; add local item

 N FDA,FDAIEN,DIERR,ERR,X

 S FDA(231.8,"+1,",.01)=$TR($P(NODE,U),"-") ;Name

 S FDA(231.8,"+1,",.02)=EDPSITE             ;Institution ien

 S FDA(231.8,"+1,",.03)=EDPAREA             ;Area ien

 S FDA(231.8,"+1,",.04)='$P(NODE,U,4)       ;Inactive

 S FDA(231.8,"+1,",.05)=$P(NODE,U,6)        ;Sequence

 S FDA(231.8,"+1,",.06)=$P(NODE,U,2)        ;Display Name

 S X=$P(NODE,U,7),X=$S(X=2:0,X=0:2,1:1)

 S FDA(231.8,"+1,",.07)=X                   ;Display When

 S FDA(231.8,"+1,",.08)=$$STS($P(NODE,U,8)) ;Default Status ien

 S FDA(231.8,"+1,",.1)=$P(NODE,U,9)         ;Shared Name [Room]

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 S Y=$S('$D(DIERR):+$G(FDAIEN(1)),1:"")

LCQ ;exit

 Q Y

 ;

NOVALUE() Q $O(^EDPB(233.1,"B","edp.reserved.novalue",0))

 ;

ORDERS(LOG,NODE) ; -- build Orders multiple

 N ORLIST,DFN,IN,OUT,ORI,ORIFN,STS,REL,PKG,X,Y,DIC,DA

 S DFN=+$P(NODE,U,6) Q:DFN<1

 S IN=$P(NODE,U,8) Q:IN<1  Q:IN<$$FMADD^XLFDT(DT,-1)  ;old

 S OUT=$P(NODE,U,9) S:OUT<1 OUT=$$NOW^XLFDT

 K ^TMP("ORR",$J) D EN^ORQ1(DFN_";DPT(",,1,,IN,OUT) S ORI=0

 F  S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI<1  S ORIFN=+$G(^(ORI)) D

 . Q:$O(^EDP(230,LOG,8,"B",ORIFN,0))

 . S X=$$GET1^DIQ(100,ORIFN_",",5,"I") Q:(X=10)!(X=11)  ;unreleased

 . S STS=$S("^1^2^7^12^13^14^"[(U_X_U):"C","^3^6^9^15^"[(U_X_U):"A",1:"N")

 . S REL=$$GET1^DIQ(100.008,"1,"_ORIFN_",",16,"I")

 . S X=$$GET1^DIQ(100,ORIFN_",","12:1")

 . S PKG=$S($E(X,1,2)="LR":"L",$E(X,1,2)="PS":"M",$E(X,1,2)="RA":"R",X="GMRC":"C",1:"A")

 . ; add to subfile

 . K X,Y,DIC,DA

 . S DIC="^EDP(230,"_LOG_",8,",DIC(0)="LZ",DA(1)=LOG,X=+ORIFN

 . S DIC("DR")=".02///"_PKG_";.03///"_STS_";.05///"_REL

 . ;S:$$VAL("stat") DIC("DR")=DIC("DR")_";.04///1"

 . D FILE^DICN

 K ^TMP("ORR",$J,ORLIST)

 Q

 ;

 ; ------- fix ICD9 Code field -------

 ;

ICD ; -- convert ICD codes to #80 iens

 N EDP1,EDP2,X0,X,Y

 S EDP1=0 F  S EDP1=$O(^EDP(230,EDP1)) Q:EDP1<1  I $D(^(EDP1,4)) D

 . S EDP2=0 F  S EDP2=$O(^EDP(230,EDP1,4,EDP2)) Q:EDP2<1  S X0=$G(^(EDP2,0)) D

 .. S X=$P(X0,U,2) Q:'$L(X)

 .. I X?1"ICD-9-CODE-".E S X=$P(X,"-",4)

 .. I X["/" S X=$P(X,"/")

 .. S Y=$$ICDDX^ICDCODE(X)

 .. I Y>0 S $P(^EDP(230,EDP1,4,EDP2,0),U,2)=+Y

 Q

 ;

SHOWICD(BEG,END) ; -- show Dx nodes from BEG to END

 N IEN,DA,X0,X

 S BEG=$G(BEG,0),END=$G(END,9999999)

 S IEN=BEG F  S IEN=$O(^EDP(230,IEN)) Q:(IEN<1)!(IEN>END)  I $D(^(IEN,4)) D

 . S DA=0 F  S DA=$O(^EDP(230,IEN,4,DA)) Q:DA<1  S X0=$G(^(DA,0)) D

 .. S X=$P(X0,U,2) Q:X=""  ;show any non-ien value

 .. I $S(X<0:1,+X'=X:1,X[".":1,1:0) W !,IEN,?10,DA,?15,X0

 Q

 ;

 ; ------ fix Tracking Room-Bed file #231.8 ------

 ;

MARK(STN) ; -- mark duplicate locations with correct ien,

 ;             for repointing from STN to Institution ien set

 N AREA,NM,IEN,LOC

 S AREA=+$O(^EDPB(231.8,"AC",STN,0))

 S NM="" F  S NM=$O(^EDPB(231.8,"AC",STN,AREA,NM)) Q:NM=""  D

 . S LOC=+$O(^EDPB(231.8,"AC",STN,AREA,NM,0))  ;keep 1st, or

 . I $G(^EDPB(231.8,LOC,"FIX")) S LOC=^("FIX") ;manually set to desired

 . S IEN=LOC F  S IEN=+$O(^EDPB(231.8,"AC",STN,AREA,NM,IEN)) Q:IEN<1  S ^EDPB(231.8,IEN,"FIX")=LOC

 Q

 ;

LOOP ; -- loop through Log,History files and repoint if FIX node exists

 N FILE,IEN,LOC,FIX

 F FILE=230,230.1 D

 . S IEN=0 F  S IEN=$O(^EDP(FILE,IEN)) Q:IEN<1  S LOC=$P($G(^(IEN,3)),U,4) I LOC D

 .. S FIX=+$G(^EDPB(231.8,LOC,"FIX"))

 .. I FIX S $P(^EDP(FILE,IEN,3),U,4)=FIX

 Q

 ;

DIK ; -- remove duplicate entries from #231.8

 N IEN,DA,DIK

 S IEN=0 F  S IEN=$O(^EDPB(231.8,IEN)) Q:IEN<1  I $G(^(IEN,"FIX")) D

 . S DA=IEN,DIK="^EDPB(231.8," D ^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---EDPCONV   9589     printed  Mar 13, 2025@20:56:23                                                                                                                                                                                                     Page 2

EDPCONV   ;SLC/MKB - Process incoming mail to convert local ED Visits ;2/28/12 08:33am

 +1       ;;2.0;EMERGENCY DEPARTMENT;**2**;Feb 24, 2012;Build 23

 +2       ;

AREA(DIV) ; -- Return #231.9 ien for DIVision (#4 ien)

 +1        QUIT +$ORDER(^EDPB(231.9,"C",DIV,0))

 +2       ;

VST(OLD)  ; -- Copy OLD(node) ER visit entry into ^EDP(230)

 +1        NEW X,I,EDPY,EDPSITE,EDPDIFF,EDPAREA,EDPSTA,EDPLOG,EDPI,PNM,SSN

 +2       ;$$TZONE(X)

           SET EDPSITE=$GET(OLD("SITE"))

           SET X=$GET(OLD("TZ"))

           SET EDPDIFF=0

 +3        SET EDPAREA=$$AREA(EDPSITE)

           if EDPAREA<1

               QUIT 

 +4       ;station number

           SET EDPSTA=$$STA^XUAF4(EDPSITE)

 +5       ;defined

           FOR I=0,1,2,3,4,6,9

               SET OLD(I)=$GET(OLD(I))

 +6        SET X=$PIECE(OLD(0),U,5)

           SET EDPY=$$NEW(230,X)

           if EDPY<1

               QUIT 

 +7       ;patient name, ssn

           SET PNM=$PIECE(OLD(0),U)

           SET SSN=$PIECE(OLD(0),U,3)

 +8       ;_U_EDPDIFF

           SET EDPLOG(0)=X_U_EDPSITE_U_EDPAREA_U_PNM_U_SSN_U_$PIECE(OLD(6),U,2)_U_$GET(OLD("CLOSED"))_U_$PIECE(OLD(4),U,4,5)_U_$$ARR($PIECE(OLD(0),U,6))_U_$$PID(PNM,SSN)

 +9       ;disposition

           SET X=$PIECE(OLD(9),U,3)

           if 'X

               SET X=$PIECE(OLD(6),U,3)

 +10       SET EDPLOG(1)=$PIECE(OLD(1),U)_U_$$DISP(X)_U_$PIECE(OLD(9),U,2)_U_$PIECE(OLD(9),U)_U_$$DEL($PIECE(OLD(4),U,7))

 +11       SET X=$PIECE(OLD(2),U)

           if $LENGTH(X)

               SET EDPLOG(2)=X

 +12       SET EDPLOG(3)=U_$$STS($PIECE(OLD(0),U,4))_U_$$ACU($PIECE(OLD(4),U,3))_U_$$LOC($PIECE(OLD(3),U,2))_U_$PIECE(OLD(4),U)_U_$PIECE(OLD(4),U,2)_U_$PIECE(OLD(4),U,6)_U_$PIECE(OLD(6),U)

 +13       IF $DATA(OLD(8))

               MERGE EDPLOG(4)=OLD(8)

               SET $PIECE(EDPLOG(4,0),U,2)="230.04A"

               Begin DoDot:1

 +14               SET EDPI=0

                   FOR 

                       SET EDPI=$ORDER(EDPLOG(4,EDPI))

                       if EDPI<1

                           QUIT 

                       Begin DoDot:2

 +15      ;code -> ien

                           SET X=$PIECE($GET(EDPLOG(4,EDPI,0)),U,2)

                           if '$LENGTH(X)

                               QUIT 

 +16                       IF X?1"ICD-9-CODE-".E

                               SET X=$PIECE(X,"-",4)

 +17                       IF X["/"

                               SET X=$PIECE(X,"/")

 +18      ;Begin EDP*2.0*2 CHANGES.

 +19                       SET X=$$ICDDX^EDPLEX(X,$PIECE($GET(^EDP(230,EDPY,0),2781001),U,8))

                           SET $PIECE(EDPLOG(4,EDPI,0),U,2)=$SELECT(X>0:+X,1:"")

 +20      ;End EDP*2.0*2 CHANGES.

                       End DoDot:2

               End DoDot:1

 +21      ; Save/Xref log entry

 +22       MERGE ^EDP(230,EDPY)=EDPLOG

 +23       DO XREF(230,EDPY)

 +24      ;

 +25      ; Set History from Movement nodes

 +26       SET EDPI="MVT"

           FOR 

               SET EDPI=$ORDER(OLD(EDPI))

               if EDPI'?1"MVT"1.N

                   QUIT 

               DO HIST(EDPI,EDPY)

 +27      ;

 +28      ; Create Orders list for active visits

 +29       IF '$GET(OLD("CLOSED"))

               SET X=EDPLOG(0)

               DO ORDERS(EDPY,X)

 +30      ;

 +31      ;return new ien

           SET OLD(230)=EDPY

 +32       QUIT 

 +33      ;

HIST(MVTI,LOG) ; -- Copy OLD(MVTI) into ^EDP(230.1)

 +1        NEW EDPY,MVT,ACT

 +2        SET EDPY=$$NEW(230.1,LOG)

           if EDPY<1

               QUIT 

 +3        SET MVT=OLD(MVTI)

 +4        SET ACT(0)=LOG_U_$PIECE(MVT,U,2)_U_U_$PIECE($GET(^EDP(230,LOG,0)),U,4,6)

 +5        SET ACT(3)=U_$$STS($PIECE(MVT,U,3))_U_$$ACU($PIECE(MVT,U,4))_U_$$LOC($PIECE(MVT,U,5))_U_$PIECE(MVT,U,6,8)

 +6       ; Save/Xref history

 +7        MERGE ^EDP(230.1,EDPY)=ACT

 +8        DO XREF(230.1,EDPY)

 +9        QUIT 

 +10      ;

NEW(FILE,X) ; -- Return ien of new entry in FILE

 +1        NEW DO,DIC,DA,Y

 +2        SET DIC="^EDP("_FILE_","

           SET DIC(0)="LF"

           DO FILE^DICN

 +3        QUIT +Y

 +4       ;

XREF(FILE,DA) ; -- Set all xrefs for DA in FILE

 +1        NEW DIK

 +2        SET DIK="^EDP("_FILE_","

           DO IX1^DIK

 +3        QUIT 

 +4       ;

PID(NM,ID) ; -- Return brief id (L0000) for patient

 +1        NEW Y

           SET Y=$EXTRACT(NM)_$EXTRACT(ID,6,9)

 +2        QUIT Y

 +3       ;

TZONE(X)  ; -- Return #minutes local offset for time zone

 +1        NEW Y

           SET Y=$EXTRACT(X)_(60*$EXTRACT(X,2,3)+$EXTRACT(X,4,5))

 +2        QUIT Y

 +3       ;

ACU(X)    ; -- Return[/add] #233.1 ien for Acuity X

 +1        IF $GET(X)=""

               QUIT ""

 +2        NEW Y,NODE

           SET NODE=$GET(OLD("ACU"_+X))

           if NODE=""

               QUIT $$NOVALUE

 +3        SET X=$PIECE(NODE,U,2)

           SET Y=""

 +4        if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AB","acuity",X,0))

           if Y

               QUIT Y

 +5       ; add local item

 +6        NEW FDA,FDAIEN,DIERR,ERR,NM

 +7        SET NM=$PIECE(NODE,U)

           SET NM=$SELECT(NM["-":$PIECE(NM,"-",2),1:NM)

 +8        SET FDA(233.1,"+1,",.01)=EDPSTA_".acuity."_$$LOW^XLFSTR(NM)

 +9        SET FDA(233.1,"+1,",.02)=X

 +10       SET FDA(233.1,"+1,",.03)=X

 +11       DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +12       SET Y=$SELECT('$DATA(DIERR):+$GET(FDAIEN(1)),1:"")

 +13       QUIT Y

 +14      ;

STS(X)    ; -- Return[/add] #233.1 ien for Status X

 +1        IF $GET(X)=""

               QUIT ""

 +2        NEW Y,NODE

 +3        SET NODE=$GET(OLD("STS"_+X))

           SET Y=""

           if NODE=""

               QUIT $$NOVALUE

 +4        SET X=$PIECE(NODE,U,1)

           if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AC","status",X,0))

           if Y

               QUIT Y

 +5        SET X=$PIECE(NODE,U,4)

           if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AB","status",X,0))

           if Y

               QUIT Y

 +6       ; add local item

 +7        NEW FDA,FDAIEN,DIERR,ERR

 +8        SET FDA(233.1,"+1,",.01)=EDPSTA_".status."_$$LOW^XLFSTR(X)

 +9       ;text

           SET FDA(233.1,"+1,",.02)=$PIECE(NODE,U)

 +10      ;display/abbreviation

           SET FDA(233.1,"+1,",.03)=X

 +11      ;admission flag

           if $PIECE(NODE,U,6)="Y"

               SET FDA(233.1,"+1,",.05)="A"

 +12       DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +13       SET Y=$SELECT('$DATA(DIERR):+$GET(FDAIEN(1)),1:"")

 +14       QUIT Y

 +15      ;

DEL(X)    ; -- Return[/add] #233.1 ien for Delay Reason X

 +1        IF $GET(X)=""

               QUIT ""

 +2        NEW Y,NODE

 +3        SET NODE=$GET(OLD("DEL"_+X))

           SET Y=""

           if NODE=""

               QUIT $$NOVALUE

 +4        SET X=$PIECE(NODE,U,1)

           if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AC","delay",X,0))

           if Y

               QUIT Y

 +5        SET X=$PIECE(NODE,U,3)

           if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AB","delay",X,0))

           if Y

               QUIT Y

 +6       ; add local item

 +7        NEW FDA,FDAIEN,DIERR,ERR

 +8        SET FDA(233.1,"+1,",.01)=EDPSTA_".delay."_$$LOW^XLFSTR(X)

 +9       ;name

           SET FDA(233.1,"+1,",.02)=$PIECE(NODE,U)

 +10      ;abbreviation

           SET FDA(233.1,"+1,",.03)=$PIECE(NODE,U,3)

 +11      ;report flag

           SET FDA(233.1,"+1,",.05)=$PIECE(NODE,U,5)

 +12       DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +13       SET Y=$SELECT('$DATA(DIERR):+$GET(FDAIEN(1)),1:"")

 +14       QUIT Y

 +15      ;

ARR(X)    ; -- Return[/add] #233.1 ien for Arrival Mode X

 +1        IF $GET(X)=""

               QUIT ""

 +2        NEW Y,NODE

 +3        SET NODE=$GET(OLD("ARR"_+X))

           SET Y=""

           if NODE=""

               QUIT $$NOVALUE

 +4        SET X=$PIECE($PIECE(NODE,U)," ")

           if $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AC","source",X,0))

           if Y

               QUIT Y

 +5       ; add local item

 +6        NEW FDA,FDAIEN,DIERR,ERR

 +7        SET FDA(233.1,"+1,",.01)=EDPSTA_".source."_$$LOW^XLFSTR(X)

 +8        SET FDA(233.1,"+1,",.02)=X

 +9        DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +10       SET Y=$SELECT('$DATA(DIERR):+$GET(FDAIEN(1)),1:"")

 +11       QUIT Y

 +12      ;

DISP(X)   ; -- Return[/add] #233.1 ien for Disposition code X

 +1        IF $GET(X)=""

               QUIT ""

 +2        NEW Y,NODE

 +3        SET NODE=$GET(OLD("DIS"_X))

           SET Y=""

           if NODE=""

               QUIT $$NOVALUE

 +4       ;ien -> abbreviation

           if X

               SET X=$PIECE(NODE,U,5)

 +5        IF $LENGTH(X)

               SET Y=+$ORDER(^EDPB(233.1,"AB","disposition",X,0))

               if Y

                   QUIT Y

 +6       IF '$TEST

               SET X=$PIECE(NODE,U)

               if $LENGTH(X)

                   SET Y=+$ORDER(^EDPB(233.1,"AC","disposition",X,0))

               if Y

                   QUIT Y

 +7       ; add local item

 +8        NEW FDA,FDAIEN,DIERR,ERR

 +9       ;1st word, for name

           SET X=$PIECE($PIECE(NODE,U)," ")

 +10       SET FDA(233.1,"+1,",.01)=EDPSTA_".disposition."_$$LOW^XLFSTR(X)

 +11      ;Display Name

           SET FDA(233.1,"+1,",.02)=$PIECE(NODE,U)

 +12      ;Abbreviation

           SET FDA(233.1,"+1,",.03)=$PIECE(NODE,U,5)

 +13      ;Missed Opportunity

           if $PIECE(NODE,U,7)

               SET FDA(233.1,"+1,",.05)="M"

 +14      ;Admission

           if $PIECE(NODE,U,6)

               SET FDA(233.1,"+1,",.05)="A"

 +15      ;VA Admission

           if $PIECE(NODE,U,8)

               SET FDA(233.1,"+1,",.05)="VA"

 +16       DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +17       SET Y=$SELECT('$DATA(DIERR):+$GET(FDAIEN(1)),1:"")

 +18       QUIT Y