EDPYPRE ;SLC/KCM - Pre init for facility install ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
S ^TMP("EDP-LAST-VERSION")=+$P($$VERSRV,"1.0-T",2)
;
D FIXT5,DELFLDS,DELCODES,CHGNAMES,FIX233
Q
;
DELFLDS ; delete obsolete fields
I $$VERGTE(20) Q ; only convert if version <20
;
N DIK,DA
I $D(^DD(230.1,1)) D
. S DIK="^DD(230.1,",DA=1,DA(1)=230.1
. D ^DIK
I $D(^DD(231.9,.04)) D
. S DIK="^DD(231.9,",DA=.04,DA(1)=231.9
. D ^DIK
Q
DELCODES ; delete site code sets
I $$VERGTE(16) Q ; only convert if version <16
;
N X,DIK,DA
S X="" F S X=$O(^EDPB(233.2,"B",X)) Q:X="" D
. I $P(X,".")="edp" Q
. S DA=$O(^EDPB(233.2,"B",X,0)) Q:'DA
. S DIK="^EDPB(233.2,"
. D ^DIK
Q
CHGNAMES ; change code names
I $$VERGTE(20) Q ; only convert if version <20
;
D CHG("edp.source.ambulance","zzedp.source.ambulance")
D CHG("edp.source.code","zzedp.source.code")
D CHG("edp.source.walk-in","zzedp.source.walk-in")
D CHG("edp.source.cboc","edp.source.clinic-offsite")
D CHG("edp.source.clinic","edp.source.clinic-onsite")
D CHG("edp.source.nhcu","edp.source.nhcu-onsite")
D CHG("edp.status.observation","zzedp.status.observation")
D CHG("edp.status.overflow","zzedp.status.overflow")
D CHG("edp.status.gone","zzedp.status.gone")
D CHG("edp.delay.admitorders","edp.delay.admitdispo")
Q
CHG(OLD,NEW) ; change old to new name
Q:'$D(^EDPB(233.1,"B",OLD))
N IEN
S IEN=$O(^EDPB(233.1,"B",OLD,0)) Q:'IEN
N FDA,DIERR
S IEN=IEN_","
S FDA(233.1,IEN,.01)=NEW
D FILE^DIE("","FDA","ERR")
D CLEAN^DILF
Q
;
; VERSRV copied from EDPQAR to avoid $T(VERSRV^EDPQAR) error
;
VERSRV() ; Return server version of option name
N EDPLST,VAL
D FIND^DIC(19,"",1,"X","EDPF TRACKING SYSTEM",1,,,,"EDPLST")
S VAL=$G(EDPLST("DILIST","ID",1,1))
S VAL=$P(VAL,"version ",2)
I 'VAL Q "1.0T?"
Q VAL
;
FIX233() ;
N IEN,DISPNM,ABBREV
S IEN=0 F S IEN=$O(^EDPB(233.1,IEN)) Q:'IEN D
.S DISPNM=$$GET1^DIQ(233.1,IEN,.02)
.S ABBREV=$$GET1^DIQ(233.1,IEN,.03)
.I DISPNM=""!(ABBREV="") D
..D DISP(IEN)
..I DISPNM="" D EDFLD(IEN,.02)
..I ABBREV="" D EDFLD(IEN,.03)
Q
DISP(IEN) ;
N DATA,ERR,IENS
S IENS=IEN_","
D GETS^DIQ(233.1,IENS,".01;.02;.03","IE","DATA","ERR")
W !,?2,"NAME: ",?20,$G(DATA(233.1,IENS,.01,"E"))
W !,?2,"DISPLAY NAME:",?20,$G(DATA(233.1,IENS,.02,"E"))
W !,?2,"ABBREVIATION:",?20,$G(DATA(233.1,IENS,.03,"E")),!
Q
EDFLD(IEN,FLD) ;
N DIE,DA,DR
S DIE("NO^")=""
W !!,"You must correct the following fields before continuing:",!
S DIE="^EDPB(233.1,",DA=IEN,DR=FLD
L +^EDPB(233.1,IEN):0
I $T D ^DIE L -^EDPB(233.1,IEN) W !!! Q
W !,?10,"Another user is editing this entry. Please try again later.",!! Q
Q
VERGTE(HIGH) ; Return 1 if existing version and greater than HIGH
I $G(^TMP("EDP-LAST-VERSION"))<1 Q 1 ; no prior version
I $G(^TMP("EDP-LAST-VERSION"))>=HIGH Q 1 ; don't convert
Q 0 ; convert
;
FIXT5 ; convert the timezone offset to visit string
; (change occurred between T5 and T6)
I $$VERGTE(6) Q ; only convert if version <6
;
N LOG,X0
S LOG=0 F S LOG=$O(^EDP(230,LOG)) Q:'LOG D
. S X0=^EDP(230,LOG,0)
. I $P(X0,U,12)="0" S $P(^EDP(230,LOG,0),U,12)=""
Q
;. To convert VSTR to VISIT
;. I $L($P(X0,U,12),";")=3 D
;.. N VSTR,VISIT,DFN,VISITIEN,I
;.. S VSTR=$P(X0,U,12),DFN=$P(X0,U,6)
;.. Q:'DFN
;.. K ^TMP("PXKENC",$J)
;.. S VISIT=+$$GETENC^PXAPI(DFN,$P(VSTR,";",2),$P(VSTR,";"))
;.. I VISIT<0 S $P(^EDP(230,LOG,0),U,12)="" Q
;.. S VISITIEN=""
;.. F I=1:1:$L(VISIT,U) I $P(^TMP("PXKENC",$J,$P(VISIT,U,I),"VST",$P(VISIT,U,I),0),U,6)=DUZ(2) S VISITIEN=$P(VISIT,U,I) Q
;.. S $P(^EDP(230,LOG,0),U,12)=VISITIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPYPRE 3751 printed Apr 09, 2024@20:57:47 Page 2
EDPYPRE ;SLC/KCM - Pre init for facility install ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
+3 SET ^TMP("EDP-LAST-VERSION")=+$PIECE($$VERSRV,"1.0-T",2)
+4 ;
+5 DO FIXT5
DO DELFLDS
DO DELCODES
DO CHGNAMES
DO FIX233
+6 QUIT
+7 ;
DELFLDS ; delete obsolete fields
+1 ; only convert if version <20
IF $$VERGTE(20)
QUIT
+2 ;
+3 NEW DIK,DA
+4 IF $DATA(^DD(230.1,1))
Begin DoDot:1
+5 SET DIK="^DD(230.1,"
SET DA=1
SET DA(1)=230.1
+6 DO ^DIK
End DoDot:1
+7 IF $DATA(^DD(231.9,.04))
Begin DoDot:1
+8 SET DIK="^DD(231.9,"
SET DA=.04
SET DA(1)=231.9
+9 DO ^DIK
End DoDot:1
+10 QUIT
DELCODES ; delete site code sets
+1 ; only convert if version <16
IF $$VERGTE(16)
QUIT
+2 ;
+3 NEW X,DIK,DA
+4 SET X=""
FOR
SET X=$ORDER(^EDPB(233.2,"B",X))
if X=""
QUIT
Begin DoDot:1
+5 IF $PIECE(X,".")="edp"
QUIT
+6 SET DA=$ORDER(^EDPB(233.2,"B",X,0))
if 'DA
QUIT
+7 SET DIK="^EDPB(233.2,"
+8 DO ^DIK
End DoDot:1
+9 QUIT
CHGNAMES ; change code names
+1 ; only convert if version <20
IF $$VERGTE(20)
QUIT
+2 ;
+3 DO CHG("edp.source.ambulance","zzedp.source.ambulance")
+4 DO CHG("edp.source.code","zzedp.source.code")
+5 DO CHG("edp.source.walk-in","zzedp.source.walk-in")
+6 DO CHG("edp.source.cboc","edp.source.clinic-offsite")
+7 DO CHG("edp.source.clinic","edp.source.clinic-onsite")
+8 DO CHG("edp.source.nhcu","edp.source.nhcu-onsite")
+9 DO CHG("edp.status.observation","zzedp.status.observation")
+10 DO CHG("edp.status.overflow","zzedp.status.overflow")
+11 DO CHG("edp.status.gone","zzedp.status.gone")
+12 DO CHG("edp.delay.admitorders","edp.delay.admitdispo")
+13 QUIT
CHG(OLD,NEW) ; change old to new name
+1 if '$DATA(^EDPB(233.1,"B",OLD))
QUIT
+2 NEW IEN
+3 SET IEN=$ORDER(^EDPB(233.1,"B",OLD,0))
if 'IEN
QUIT
+4 NEW FDA,DIERR
+5 SET IEN=IEN_","
+6 SET FDA(233.1,IEN,.01)=NEW
+7 DO FILE^DIE("","FDA","ERR")
+8 DO CLEAN^DILF
+9 QUIT
+10 ;
+11 ; VERSRV copied from EDPQAR to avoid $T(VERSRV^EDPQAR) error
+12 ;
VERSRV() ; Return server version of option name
+1 NEW EDPLST,VAL
+2 DO FIND^DIC(19,"",1,"X","EDPF TRACKING SYSTEM",1,,,,"EDPLST")
+3 SET VAL=$GET(EDPLST("DILIST","ID",1,1))
+4 SET VAL=$PIECE(VAL,"version ",2)
+5 IF 'VAL
QUIT "1.0T?"
+6 QUIT VAL
+7 ;
FIX233() ;
+1 NEW IEN,DISPNM,ABBREV
+2 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(233.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET DISPNM=$$GET1^DIQ(233.1,IEN,.02)
+4 SET ABBREV=$$GET1^DIQ(233.1,IEN,.03)
+5 IF DISPNM=""!(ABBREV="")
Begin DoDot:2
+6 DO DISP(IEN)
+7 IF DISPNM=""
DO EDFLD(IEN,.02)
+8 IF ABBREV=""
DO EDFLD(IEN,.03)
End DoDot:2
End DoDot:1
+9 QUIT
DISP(IEN) ;
+1 NEW DATA,ERR,IENS
+2 SET IENS=IEN_","
+3 DO GETS^DIQ(233.1,IENS,".01;.02;.03","IE","DATA","ERR")
+4 WRITE !,?2,"NAME: ",?20,$GET(DATA(233.1,IENS,.01,"E"))
+5 WRITE !,?2,"DISPLAY NAME:",?20,$GET(DATA(233.1,IENS,.02,"E"))
+6 WRITE !,?2,"ABBREVIATION:",?20,$GET(DATA(233.1,IENS,.03,"E")),!
+7 QUIT
EDFLD(IEN,FLD) ;
+1 NEW DIE,DA,DR
+2 SET DIE("NO^")=""
+3 WRITE !!,"You must correct the following fields before continuing:",!
+4 SET DIE="^EDPB(233.1,"
SET DA=IEN
SET DR=FLD
+5 LOCK +^EDPB(233.1,IEN):0
+6 IF $TEST
DO ^DIE
LOCK -^EDPB(233.1,IEN)
WRITE !!!
QUIT
+7 WRITE !,?10,"Another user is editing this entry. Please try again later.",!!
QUIT
+8 QUIT
VERGTE(HIGH) ; Return 1 if existing version and greater than HIGH
+1 ; no prior version
IF $GET(^TMP("EDP-LAST-VERSION"))<1
QUIT 1
+2 ; don't convert
IF $GET(^TMP("EDP-LAST-VERSION"))>=HIGH
QUIT 1
+3 ; convert
QUIT 0
+4 ;
FIXT5 ; convert the timezone offset to visit string
+1 ; (change occurred between T5 and T6)
+2 ; only convert if version <6
IF $$VERGTE(6)
QUIT
+3 ;
+4 NEW LOG,X0
+5 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,LOG))
if 'LOG
QUIT
Begin DoDot:1
+6 SET X0=^EDP(230,LOG,0)
+7 IF $PIECE(X0,U,12)="0"
SET $PIECE(^EDP(230,LOG,0),U,12)=""
End DoDot:1
+8 QUIT
+9 ;. To convert VSTR to VISIT
+10 ;. I $L($P(X0,U,12),";")=3 D
+11 ;.. N VSTR,VISIT,DFN,VISITIEN,I
+12 ;.. S VSTR=$P(X0,U,12),DFN=$P(X0,U,6)
+13 ;.. Q:'DFN
+14 ;.. K ^TMP("PXKENC",$J)
+15 ;.. S VISIT=+$$GETENC^PXAPI(DFN,$P(VSTR,";",2),$P(VSTR,";"))
+16 ;.. I VISIT<0 S $P(^EDP(230,LOG,0),U,12)="" Q
+17 ;.. S VISITIEN=""
+18 ;.. F I=1:1:$L(VISIT,U) I $P(^TMP("PXKENC",$J,$P(VISIT,U,I),"VST",$P(VISIT,U,I),0),U,6)=DUZ(2) S VISITIEN=$P(VISIT,U,I) Q
+19 ;.. S $P(^EDP(230,LOG,0),U,12)=VISITIEN
+20 QUIT
