EDPFMOVE ;SLC/MKB - Move local ER Visits to EDIS ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
EN ; -- Option EDP CONVERSION to copy local data
I '$D(^DIZ(172006,0)) W !!,"You have no ER data to convert." H 1 Q
I $G(^XTMP("EDP-CONV","X"))="DONE" W !!,"The data conversion has completed." H 1 Q
;
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,EDPDIV
W !!,"This option will copy ER configuration and visit data at your site"
W !,"to the new Emergency Department application. For each division,"
W !,"your local configuration data will be copied first, followed by all"
W !,"currently active patient visits. A task will then be queued to"
W !,"populate previous, closed visits in the national application files"
W !,"to allow reports to continue to function."
S EDPDIV=$$SELDIV Q:'EDPDIV
I '$$AREA(EDPDIV) W !!,"Please create a Tracking Area for this division.",! Q
D SELCVT Q:EDPDIV="^"
W !!,"DO NOT PROCEED UNTIL YOU ARE READY TO USE THE NEW EDIS PACKAGE!!",!
S DIR(0)="YA",DIR("A")="Are you ready? ",DIR("B")="NO"
D ^DIR Q:'Y
;
E1 ; -- start here
D CONFIG
D ACTIVE
; -- task LOOP
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
S ZTSK=$P($G(^XTMP("EDP-CONV","D",EDPDIV)),U,4) I ZTSK D Q:$G(ZTSK)
. D STAT^%ZTLOAD N STS S STS=+$G(ZTSK(1))
. I STS=1!(STS=2) W !,"Visit conversion is still running." Q
. K ZTSK
. ; STS=4!(STS=5) K ZTSK Q ;never ran or errored out
. ; STS=3!(STS=0) K ZTSK Q ;completed or undefined
S ZTRTN="LOOP^EDPFMOVE",ZTIO="",ZTDTH=$H,ZTSAVE("EDPDIV")=""
S ZTDESC="Copy old ER data to new EDIS application"
D ^%ZTLOAD I $G(ZTSK) D Q
. W !,"Task #"_ZTSK_" started to copy closed visits."
. S $P(^XTMP("EDP-CONV","D",EDPDIV),U,4)=ZTSK
W !,"ERROR -- Task to copy closed visits NOT started!"
Q
;
CONFIG ; -- convert site configuration
N EDPI,MSG,N,I,X0,XMZ K XMMG
S EDPI=$P($G(^XTMP("EDP-CONV","D",EDPDIV)),U) ; = ien^0^0 in post-init
I EDPI="" W !,"Configuration data for "_$$NAME^XUAF4(EDPDIV)_" has already been copied." Q
I EDPI=-1 W !,"Configuration data for "_$$NAME^XUAF4(EDPDIV)_" will not be copied." Q
W !,"Copying local configuration ... "
F S EDPI=$O(^DIZ(172012,EDPI)) Q:EDPI<1 D Q:$D(XMMG)
. K MSG S MSG(1)="command=convertConfiguration",N=1
. S X0=$G(^DIZ(172012,EDPI,0))
. S N=N+1,MSG(N)="SITE="_EDPDIV
. S N=N+1,MSG(N)="TZ="_$$TZ^XLFDT
. F I=2,3,5 S N=N+1,MSG(N)=I_"="_$G(^DIZ(172012,EDPI,I))
. ; include acuities and statuses for default colors
. S I=0 F S I=$O(^DIZ(172007,"D",EDPDIV,I)) Q:I<1 D
.. S X0=$G(^DIZ(172007,I,0)) Q:'$P(X0,U,6) ;inactive
.. S $P(X0,U,3)=$$EXTERNAL^DILFD(172007,2,"",$P(X0,U,3))
.. S $P(X0,U,4)=$$EXTERNAL^DILFD(172007,3,"",$P(X0,U,4))
.. S N=N+1,MSG(N)="ACU"_I_"="_X0
. S I=0 F S I=$O(^DIZ(172009,I)) Q:I<1 S X0=$G(^(I,0)) D
.. S $P(X0,U,2)=$$EXTERNAL^DILFD(172009,1,"",$P(X0,U,2))
.. S $P(X0,U,3)=$$EXTERNAL^DILFD(172009,2,"",$P(X0,U,3))
.. S N=N+1,MSG(N)="STS"_I_"="_X0
. D SEND^EDPFMON(.MSG)
S $P(^XTMP("EDP-CONV","D",EDPDIV),U)="" ;done
Q
;
ACTIVE ; -- Loop through ER Locations, convert open visits first
N EDPL,VST,XMZ
S EDPL=$P($G(^XTMP("EDP-CONV","D",EDPDIV)),U,2) ; = ien^0^0 in post-init
I EDPL="" Q ;W !,"Active visits already copied." Q
W !,"Copying currently active visits ... "
F S EDPL=$O(^DIZ(172008,"C",EDPDIV,EDPL)) Q:EDPL<1 D
. S VST=$P($G(^DIZ(172008,EDPL,0)),U,5) Q:'VST
. D EN1(VST,1) S ^XTMP("EDP-CONV",VST)=""
. S $P(^XTMP("EDP-CONV","D",EDPDIV),U,2)=EDPL
S $P(^XTMP("EDP-CONV","D",EDPDIV),U,2)="" ;done
Q
;
LOOP ; -- Queued loop to send previous [closed] visits
N EDPI
S EDPI=$P($G(^XTMP("EDP-CONV","D",EDPDIV)),U,3)
F S EDPI=$O(^DIZ(172006,"E",EDPDIV,EDPI)) Q:EDPI<1 D
. I $D(^XTMP("EDP-CONV",EDPI)) S $P(^XTMP("EDP-CONV","D",EDPDIV),U,3)=EDPI Q
. D EN1(EDPI)
. S $P(^XTMP("EDP-CONV","D",EDPDIV),U,3)=EDPI
;S ^XTMP("EDP-CONV","X")="DONE"
Q
;
EN1(IEN,OPEN) ; -- convert single ER visit
N I,X,Y,X0,DIZ,GONE
S GONE=$D(^DIZ(172009,"B","GONE"))
F I=0,1,2,3,4,6,9 S DIZ(I)=$G(^DIZ(172006,IEN,I))
I $O(^DIZ(172006,IEN,8,0)) M DIZ(8)=^DIZ(172006,IEN,8)
S X=$P(DIZ(3),U),DIZ("SITE")=X ;Institution file ien
S DIZ("TZ")=$$TZ^XLFDT ;Time Zone difference
; S:'$G(OPEN) DIZ("CLOSED")=1 ;Closed visit
;
;include static file nodes used:
S X=$P(DIZ(0),U,4) S:X DIZ("STS"_X)=$$STS(X) ;Status
I '$G(OPEN) D ;Closed Status
. I '$G(GONE) S DIZ("CLOSED")=1
. I $G(GONE),X,$P($G(DIZ("STS"_X)),U,4)="GONE" S DIZ("CLOSED")=1
S X=$P(DIZ(0),U,6) S:X DIZ("ARR"_X)=$$ARR(X) ;Arrival Mode
S X=$P(DIZ(3),U,2) S:X DIZ("LOC"_X)=$$LOC(X) ;Location
S X=$P(DIZ(4),U,2) S:X $P(DIZ(4),U,2)=$$NUR(X) ;RN->200
S X=$P(DIZ(4),U,3) S:X DIZ("ACU"_X)=$$ACU(X) ;Acuity
S X=$P(DIZ(4),U,7) S:X DIZ("DEL"_X)=$$DEL(X) ;Delay Reason
S X=$P(DIZ(9),U,3) S:X DIZ("DIS"_X)=$$DIS(X) ;Disposition
I 'X S X=$P(DIZ(6),U,3) S:$L(X) DIZ("DIS"_X)=$$EXTERNAL^DILFD(172006,16,,X)_"^1^^^"_X
S I=0 F S I=$O(^DIZ(172006,IEN,7,I)) Q:I<1 S X0=$G(^(I,0)) D
. S X=$P(X0,U,3) I X,'$D(DIZ("STS"_X)) S DIZ("STS"_X)=$$STS(X)
. S X=$P(X0,U,4) I X,'$D(DIZ("ACU"_X)) S DIZ("ACU"_X)=$$ACU(X)
. S X=$P(X0,U,5) I X,'$D(DIZ("LOC"_X)) S DIZ("LOC"_X)=$$LOC(X)
. S X=$P(X0,U,7) S:X $P(X0,U,7)=$$NUR(X) ;RN->200
. S DIZ("MVT"_I)=X0
;
;send to nat'l file
;N MSG S MSG(1)="command=convertVisit",I=1
;S X="" F S X=$O(DIZ(X)) Q:X="" S I=I+1,MSG(I)=X_"="_DIZ(X)
;D SEND^EDPFMON(.MSG)
;
D VST^EDPCONV(.DIZ)
I $G(DIZ(230)) S ^DIZ(172006,IEN,230)=DIZ(230)
Q
;
LOC(X) ; -- Return 0-node for Location ien X
N NODE,S S NODE=$G(^DIZ(172008,+$G(X),0))
S S=$P(NODE,U,8) I S,'$D(DIZ("STS"_S)) S DIZ("STS"_S)=$$STS(S)
Q NODE
;
ACU(X) ; -- Return 0-node for Acuity ien X
Q $G(^DIZ(172007,+$G(X),0))
;
STS(X) ; -- Return 0-node for Status ien X
Q $G(^DIZ(172009,+$G(X),0))
;
DEL(X) ; -- Return 0-node for Delay Reason ien X
Q $G(^DIZ(172011,+$G(X),0))
;
ARR(X) ; -- Return 0-node for Arrival Mode ien X
Q $G(^DIZ(172014,+$G(X),0))
;
DIS(X) ; -- Return 0-node for Disposition ien X
Q $G(^DIZ(172015,+$G(X),0))
;
PER(X) ; -- Return NAME^INITIALS for New Person ien X
Q $P($G(^VA(200,+$G(X),0)),U,1,2)
;
NUR(X) ; -- Return #200 ptr for Nurse Staff ien X
Q $P($G(^NURSF(210,+$G(X),0)),U)
;
SELDIV() ; -- Select division ien to convert
N I,DIV,CNT,X,Y,DIC,DTOUT,DUOUT
S I=0 F S I=$O(^XTMP("EDP-CONV","D",I)) Q:I<1 S X=$G(^(I)) D
. I $P(X,U)<1,$O(^DIZ(172006,"E",I,"A"),-1)'>$P(X,U,3) Q
. S DIV(I)=$$NS^XUAF4(I),CNT=+$G(CNT)+1
I '$O(DIV(0)) W !!,"There is no data to convert." Q
S DIC=4,DIC(0)="AEQMN",DIC("S")="I $D(DIV(Y))"
I $G(CNT)=1 S I=$O(DIV(0)),DIC("B")=$P(DIV(I),U,2)
S DIC("A")="Select the division you wish to convert: "
W !!,"Available divisions: "
S I=0 F S I=$O(DIV(I)) Q:I<1 W !,$P(DIV(I),U,2),?10,$P(DIV(I),U)
D ^DIC S Y=$S(Y>0:+Y,1:0)
Q Y
;
AREA(D) ; -- Return Tracking Area #231.9 ien for Division ien
Q +$O(^EDPB(231.9,"C",+$G(D),0))
;
SELCVT ; -- Select what to convert: configuration, data, or both
Q:$P($G(^XTMP("EDP-CONV","D",EDPDIV)),U)=""
N X,Y,DIR,DTOUT,DUOUT
S DIR(0)="YA" W !
S DIR("A")="Do you wish to convert the configuration as well as the data? "
S DIR("?",1)="Enter YES if you wish to convert this division's configuration as well"
S DIR("?")="as the patient data, otherwise enter NO to convert only the data."
D ^DIR I Y'=1,Y'=0 S EDPDIV="^" Q
S $P(^XTMP("EDP-CONV","D",EDPDIV),U)=$S(Y=0:-1,1:+$O(^DIZ(172012,"B",EDPDIV,0)))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPFMOVE 7617 printed Apr 09, 2024@20:57:11 Page 2
EDPFMOVE ;SLC/MKB - Move local ER Visits to EDIS ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
EN ; -- Option EDP CONVERSION to copy local data
+1 IF '$DATA(^DIZ(172006,0))
WRITE !!,"You have no ER data to convert."
HANG 1
QUIT
+2 IF $GET(^XTMP("EDP-CONV","X"))="DONE"
WRITE !!,"The data conversion has completed."
HANG 1
QUIT
+3 ;
+4 NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,EDPDIV
+5 WRITE !!,"This option will copy ER configuration and visit data at your site"
+6 WRITE !,"to the new Emergency Department application. For each division,"
+7 WRITE !,"your local configuration data will be copied first, followed by all"
+8 WRITE !,"currently active patient visits. A task will then be queued to"
+9 WRITE !,"populate previous, closed visits in the national application files"
+10 WRITE !,"to allow reports to continue to function."
+11 SET EDPDIV=$$SELDIV
if 'EDPDIV
QUIT
+12 IF '$$AREA(EDPDIV)
WRITE !!,"Please create a Tracking Area for this division.",!
QUIT
+13 DO SELCVT
if EDPDIV="^"
QUIT
+14 WRITE !!,"DO NOT PROCEED UNTIL YOU ARE READY TO USE THE NEW EDIS PACKAGE!!",!
+15 SET DIR(0)="YA"
SET DIR("A")="Are you ready? "
SET DIR("B")="NO"
+16 DO ^DIR
if 'Y
QUIT
+17 ;
E1 ; -- start here
+1 DO CONFIG
+2 DO ACTIVE
+3 ; -- task LOOP
+4 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+5 SET ZTSK=$PIECE($GET(^XTMP("EDP-CONV","D",EDPDIV)),U,4)
IF ZTSK
Begin DoDot:1
+6 DO STAT^%ZTLOAD
NEW STS
SET STS=+$GET(ZTSK(1))
+7 IF STS=1!(STS=2)
WRITE !,"Visit conversion is still running."
QUIT
+8 KILL ZTSK
+9 ; STS=4!(STS=5) K ZTSK Q ;never ran or errored out
+10 ; STS=3!(STS=0) K ZTSK Q ;completed or undefined
End DoDot:1
if $GET(ZTSK)
QUIT
+11 SET ZTRTN="LOOP^EDPFMOVE"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("EDPDIV")=""
+12 SET ZTDESC="Copy old ER data to new EDIS application"
+13 DO ^%ZTLOAD
IF $GET(ZTSK)
Begin DoDot:1
+14 WRITE !,"Task #"_ZTSK_" started to copy closed visits."
+15 SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U,4)=ZTSK
End DoDot:1
QUIT
+16 WRITE !,"ERROR -- Task to copy closed visits NOT started!"
+17 QUIT
+18 ;
CONFIG ; -- convert site configuration
+1 NEW EDPI,MSG,N,I,X0,XMZ
KILL XMMG
+2 ; = ien^0^0 in post-init
SET EDPI=$PIECE($GET(^XTMP("EDP-CONV","D",EDPDIV)),U)
+3 IF EDPI=""
WRITE !,"Configuration data for "_$$NAME^XUAF4(EDPDIV)_" has already been copied."
QUIT
+4 IF EDPI=-1
WRITE !,"Configuration data for "_$$NAME^XUAF4(EDPDIV)_" will not be copied."
QUIT
+5 WRITE !,"Copying local configuration ... "
+6 FOR
SET EDPI=$ORDER(^DIZ(172012,EDPI))
if EDPI<1
QUIT
Begin DoDot:1
+7 KILL MSG
SET MSG(1)="command=convertConfiguration"
SET N=1
+8 SET X0=$GET(^DIZ(172012,EDPI,0))
+9 SET N=N+1
SET MSG(N)="SITE="_EDPDIV
+10 SET N=N+1
SET MSG(N)="TZ="_$$TZ^XLFDT
+11 FOR I=2,3,5
SET N=N+1
SET MSG(N)=I_"="_$GET(^DIZ(172012,EDPI,I))
+12 ; include acuities and statuses for default colors
+13 SET I=0
FOR
SET I=$ORDER(^DIZ(172007,"D",EDPDIV,I))
if I<1
QUIT
Begin DoDot:2
+14 ;inactive
SET X0=$GET(^DIZ(172007,I,0))
if '$PIECE(X0,U,6)
QUIT
+15 SET $PIECE(X0,U,3)=$$EXTERNAL^DILFD(172007,2,"",$PIECE(X0,U,3))
+16 SET $PIECE(X0,U,4)=$$EXTERNAL^DILFD(172007,3,"",$PIECE(X0,U,4))
+17 SET N=N+1
SET MSG(N)="ACU"_I_"="_X0
End DoDot:2
+18 SET I=0
FOR
SET I=$ORDER(^DIZ(172009,I))
if I<1
QUIT
SET X0=$GET(^(I,0))
Begin DoDot:2
+19 SET $PIECE(X0,U,2)=$$EXTERNAL^DILFD(172009,1,"",$PIECE(X0,U,2))
+20 SET $PIECE(X0,U,3)=$$EXTERNAL^DILFD(172009,2,"",$PIECE(X0,U,3))
+21 SET N=N+1
SET MSG(N)="STS"_I_"="_X0
End DoDot:2
+22 DO SEND^EDPFMON(.MSG)
End DoDot:1
if $DATA(XMMG)
QUIT
+23 ;done
SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U)=""
+24 QUIT
+25 ;
ACTIVE ; -- Loop through ER Locations, convert open visits first
+1 NEW EDPL,VST,XMZ
+2 ; = ien^0^0 in post-init
SET EDPL=$PIECE($GET(^XTMP("EDP-CONV","D",EDPDIV)),U,2)
+3 ;W !,"Active visits already copied." Q
IF EDPL=""
QUIT
+4 WRITE !,"Copying currently active visits ... "
+5 FOR
SET EDPL=$ORDER(^DIZ(172008,"C",EDPDIV,EDPL))
if EDPL<1
QUIT
Begin DoDot:1
+6 SET VST=$PIECE($GET(^DIZ(172008,EDPL,0)),U,5)
if 'VST
QUIT
+7 DO EN1(VST,1)
SET ^XTMP("EDP-CONV",VST)=""
+8 SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U,2)=EDPL
End DoDot:1
+9 ;done
SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U,2)=""
+10 QUIT
+11 ;
LOOP ; -- Queued loop to send previous [closed] visits
+1 NEW EDPI
+2 SET EDPI=$PIECE($GET(^XTMP("EDP-CONV","D",EDPDIV)),U,3)
+3 FOR
SET EDPI=$ORDER(^DIZ(172006,"E",EDPDIV,EDPI))
if EDPI<1
QUIT
Begin DoDot:1
+4 IF $DATA(^XTMP("EDP-CONV",EDPI))
SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U,3)=EDPI
QUIT
+5 DO EN1(EDPI)
+6 SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U,3)=EDPI
End DoDot:1
+7 ;S ^XTMP("EDP-CONV","X")="DONE"
+8 QUIT
+9 ;
EN1(IEN,OPEN) ; -- convert single ER visit
+1 NEW I,X,Y,X0,DIZ,GONE
+2 SET GONE=$DATA(^DIZ(172009,"B","GONE"))
+3 FOR I=0,1,2,3,4,6,9
SET DIZ(I)=$GET(^DIZ(172006,IEN,I))
+4 IF $ORDER(^DIZ(172006,IEN,8,0))
MERGE DIZ(8)=^DIZ(172006,IEN,8)
+5 ;Institution file ien
SET X=$PIECE(DIZ(3),U)
SET DIZ("SITE")=X
+6 ;Time Zone difference
SET DIZ("TZ")=$$TZ^XLFDT
+7 ; S:'$G(OPEN) DIZ("CLOSED")=1 ;Closed visit
+8 ;
+9 ;include static file nodes used:
+10 ;Status
SET X=$PIECE(DIZ(0),U,4)
if X
SET DIZ("STS"_X)=$$STS(X)
+11 ;Closed Status
IF '$GET(OPEN)
Begin DoDot:1
+12 IF '$GET(GONE)
SET DIZ("CLOSED")=1
+13 IF $GET(GONE)
IF X
IF $PIECE($GET(DIZ("STS"_X)),U,4)="GONE"
SET DIZ("CLOSED")=1
End DoDot:1
+14 ;Arrival Mode
SET X=$PIECE(DIZ(0),U,6)
if X
SET DIZ("ARR"_X)=$$ARR(X)
+15 ;Location
SET X=$PIECE(DIZ(3),U,2)
if X
SET DIZ("LOC"_X)=$$LOC(X)
+16 ;RN->200
SET X=$PIECE(DIZ(4),U,2)
if X
SET $PIECE(DIZ(4),U,2)=$$NUR(X)
+17 ;Acuity
SET X=$PIECE(DIZ(4),U,3)
if X
SET DIZ("ACU"_X)=$$ACU(X)
+18 ;Delay Reason
SET X=$PIECE(DIZ(4),U,7)
if X
SET DIZ("DEL"_X)=$$DEL(X)
+19 ;Disposition
SET X=$PIECE(DIZ(9),U,3)
if X
SET DIZ("DIS"_X)=$$DIS(X)
+20 IF 'X
SET X=$PIECE(DIZ(6),U,3)
if $LENGTH(X)
SET DIZ("DIS"_X)=$$EXTERNAL^DILFD(172006,16,,X)_"^1^^^"_X
+21 SET I=0
FOR
SET I=$ORDER(^DIZ(172006,IEN,7,I))
if I<1
QUIT
SET X0=$GET(^(I,0))
Begin DoDot:1
+22 SET X=$PIECE(X0,U,3)
IF X
IF '$DATA(DIZ("STS"_X))
SET DIZ("STS"_X)=$$STS(X)
+23 SET X=$PIECE(X0,U,4)
IF X
IF '$DATA(DIZ("ACU"_X))
SET DIZ("ACU"_X)=$$ACU(X)
+24 SET X=$PIECE(X0,U,5)
IF X
IF '$DATA(DIZ("LOC"_X))
SET DIZ("LOC"_X)=$$LOC(X)
+25 ;RN->200
SET X=$PIECE(X0,U,7)
if X
SET $PIECE(X0,U,7)=$$NUR(X)
+26 SET DIZ("MVT"_I)=X0
End DoDot:1
+27 ;
+28 ;send to nat'l file
+29 ;N MSG S MSG(1)="command=convertVisit",I=1
+30 ;S X="" F S X=$O(DIZ(X)) Q:X="" S I=I+1,MSG(I)=X_"="_DIZ(X)
+31 ;D SEND^EDPFMON(.MSG)
+32 ;
+33 DO VST^EDPCONV(.DIZ)
+34 IF $GET(DIZ(230))
SET ^DIZ(172006,IEN,230)=DIZ(230)
+35 QUIT
+36 ;
LOC(X) ; -- Return 0-node for Location ien X
+1 NEW NODE,S
SET NODE=$GET(^DIZ(172008,+$GET(X),0))
+2 SET S=$PIECE(NODE,U,8)
IF S
IF '$DATA(DIZ("STS"_S))
SET DIZ("STS"_S)=$$STS(S)
+3 QUIT NODE
+4 ;
ACU(X) ; -- Return 0-node for Acuity ien X
+1 QUIT $GET(^DIZ(172007,+$GET(X),0))
+2 ;
STS(X) ; -- Return 0-node for Status ien X
+1 QUIT $GET(^DIZ(172009,+$GET(X),0))
+2 ;
DEL(X) ; -- Return 0-node for Delay Reason ien X
+1 QUIT $GET(^DIZ(172011,+$GET(X),0))
+2 ;
ARR(X) ; -- Return 0-node for Arrival Mode ien X
+1 QUIT $GET(^DIZ(172014,+$GET(X),0))
+2 ;
DIS(X) ; -- Return 0-node for Disposition ien X
+1 QUIT $GET(^DIZ(172015,+$GET(X),0))
+2 ;
PER(X) ; -- Return NAME^INITIALS for New Person ien X
+1 QUIT $PIECE($GET(^VA(200,+$GET(X),0)),U,1,2)
+2 ;
NUR(X) ; -- Return #200 ptr for Nurse Staff ien X
+1 QUIT $PIECE($GET(^NURSF(210,+$GET(X),0)),U)
+2 ;
SELDIV() ; -- Select division ien to convert
+1 NEW I,DIV,CNT,X,Y,DIC,DTOUT,DUOUT
+2 SET I=0
FOR
SET I=$ORDER(^XTMP("EDP-CONV","D",I))
if I<1
QUIT
SET X=$GET(^(I))
Begin DoDot:1
+3 IF $PIECE(X,U)<1
IF $ORDER(^DIZ(172006,"E",I,"A"),-1)'>$PIECE(X,U,3)
QUIT
+4 SET DIV(I)=$$NS^XUAF4(I)
SET CNT=+$GET(CNT)+1
End DoDot:1
+5 IF '$ORDER(DIV(0))
WRITE !!,"There is no data to convert."
QUIT
+6 SET DIC=4
SET DIC(0)="AEQMN"
SET DIC("S")="I $D(DIV(Y))"
+7 IF $GET(CNT)=1
SET I=$ORDER(DIV(0))
SET DIC("B")=$PIECE(DIV(I),U,2)
+8 SET DIC("A")="Select the division you wish to convert: "
+9 WRITE !!,"Available divisions: "
+10 SET I=0
FOR
SET I=$ORDER(DIV(I))
if I<1
QUIT
WRITE !,$PIECE(DIV(I),U,2),?10,$PIECE(DIV(I),U)
+11 DO ^DIC
SET Y=$SELECT(Y>0:+Y,1:0)
+12 QUIT Y
+13 ;
AREA(D) ; -- Return Tracking Area #231.9 ien for Division ien
+1 QUIT +$ORDER(^EDPB(231.9,"C",+$GET(D),0))
+2 ;
SELCVT ; -- Select what to convert: configuration, data, or both
+1 if $PIECE($GET(^XTMP("EDP-CONV","D",EDPDIV)),U)=""
QUIT
+2 NEW X,Y,DIR,DTOUT,DUOUT
+3 SET DIR(0)="YA"
WRITE !
+4 SET DIR("A")="Do you wish to convert the configuration as well as the data? "
+5 SET DIR("?",1)="Enter YES if you wish to convert this division's configuration as well"
+6 SET DIR("?")="as the patient data, otherwise enter NO to convert only the data."
+7 DO ^DIR
IF Y'=1
IF Y'=0
SET EDPDIV="^"
QUIT
+8 SET $PIECE(^XTMP("EDP-CONV","D",EDPDIV),U)=$SELECT(Y=0:-1,1:+$ORDER(^DIZ(172012,"B",EDPDIV,0)))
+9 QUIT
