EDPYPST ;SLC/KCM - Post init for facility install ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
D PROXY,CONVERT,FIXSPEC,FIXWAIT,FIXDFLT,AO,CHOICES,DELBRD,FIXAPX,FIXSTA,FIXICD,FIXPDFN
K ^TMP("EDP-LAST-VERSION")
Q
;
PROXY ; Create proxy user
Q:$O(^VA(200,"B","EDPTRACKING,PROXY",0))
N X
S X=$$CREATE^XUSAP("EDPTRACKING,PROXY","","EDPS BOARD CONTEXT")
Q
;
CONVERT ; set ^XTMP for tracking conversion
Q:'$D(^DIZ(172006,0)) Q:$G(^XTMP("EDP-CONV"))="DONE"
I '$D(^XTMP("EDP-CONV")) S ^XTMP("EDP-CONV",0)=$$FMADD^XLFDT(DT,365)_U_DT_"^Copy ED data to EDIS files"
N I,DIV,X S X=$G(^XTMP("EDP-CONV","X")) ;old format
S I=0 F S I=$O(^DIZ(172012,I)) Q:I<1 D
. S DIV=$$DIV(I) Q:'DIV Q:$D(^XTMP("EDP-CONV","D",DIV))
. N X1,X2,X3 S (X2,X3)=0
. S X1=$S($L(X):"",1:I)
. S:$P(X,U,2) X2="" I $P(X,U,3) S X2="" D ;old format - active done
.. N L S L=$P(X,U,3)+1
.. F S L=$O(^DIZ(172006,L),-1) Q:L<1 I +$G(^(L,3))=DIV S X3=L Q
. S ^XTMP("EDP-CONV","D",DIV)=X1_U_X2_U_X3 ; I^0^0
Q
DIV(X) ; return file 4 ien for Configuration
N X0,Y
S X0=$G(^DIZ(172012,+$G(X),0)),Y=+X0
I Y<1 S Y=+$S($P(X0,U,2):$P(X0,U,2),1:$$SITE^VASITE)
Q Y
;
FIXSPEC ; add the display properties to existing spec
I $$VERGTE^EDPYPRE(16) Q ; only convert if version <16
;
N SPEC
S SPEC=0 F S SPEC=$O(^EDPB(231.9,SPEC)) Q:'SPEC D ADDPROP(SPEC),MOVEBRD(SPEC)
Q
ADDPROP(SPEC) ; add display properties to spec
N I,X,WP,ORIG,SKIP,DIERR
S SKIP=0
S I=0 F S I=$O(^EDPB(231.9,SPEC,2,I)) Q:'I D
. S ORIG(I)=^EDPB(231.9,SPEC,2,I,0)
. I ORIG(I)["displayProperties" S SKIP=1
Q:SKIP
;
N LN S LN=0
S I=0 F S I=$O(ORIG(I)) Q:'I D
. S LN=LN+1 S WP(LN)=ORIG(I)
. I ORIG(I)["<spec>" S LN=LN+1,WP(LN)=$P($T(DP+1),";",3,99)
D WP^DIE(231.9,SPEC_",",2,"","WP")
D CLEAN^DILF
Q
MOVEBRD(AREA) ; move the display board spec into a multiple
I $P($G(^EDPB(231.9,AREA,4,0)),U,4) Q ; already entries in the multiple
I '$O(^EDPB(231.9,AREA,2,0)) Q ; no spec to move
;
N I,X0,WP,MSG
S I=0 F S I=$O(^EDPB(231.9,AREA,2,I)) Q:'I D
. S X0=^EDPB(231.9,AREA,2,I,0)
. Q:X0="<spec>" Q:X0="</spec>"
. S WP(I)=X0
D UPDBRD^EDPBCF(AREA,0,"Main (default)",.WP,.MSG)
Q
DP ; default display properties
;;<displayProperties fontSize="10" displayWidth="1024" displayLabel="1024x768" scrollDelay="7" />
;
FIXWAIT ; change the category of waiting room to "waiting"
I $$VERGTE^EDPYPRE(14) Q ; only convert if version <14
;
N IEN
S IEN=0 F S IEN=$O(^EDPB(231.8,"B","Waiting",IEN)) Q:'IEN D
. S $P(^EDPB(231.8,IEN,0),U,9)=2
Q
FIXDFLT ; create initial default rooms
N AREA,X1,AMB,DFLT,STN
S AREA=0 F S AREA=$O(^EDPB(231.9,AREA)) Q:'AREA D
. S X1=$G(^EDPB(231.9,AREA,1)),AMB=$P(X1,U,11),DFLT=$P(X1,U,12)
. S STN=$P(^EDPB(231.9,AREA,0),U,2)
. I 'AMB D
. . S AMB=$O(^EDPB(231.8,"AC",STN,AREA,"AMBU",0))
. . S:AMB $P(^EDPB(231.9,AREA,1),U,11)=AMB
. I 'DFLT D
. . S DFLT=$O(^EDPB(231.8,"AC",STN,AREA,"WAIT",0))
. . S $P(^EDPB(231.9,AREA,1),U,12)=DFLT
Q
;
DELBRD ; delete the DD and data for the old display board spec
I $$VERGTE^EDPYPRE(20) Q ; only convert if version <20
;
I $$GET1^DID(231.9,2,,"TYPE")'="WORD-PROCESSING" Q
N DIU
S DIU=231.92,DIU(0)="SD"
D EN^DIU2
Q
AO ; build AO index on #230
Q:$D(^EDP(230,"AO"))
N LOG,IEN,ORD
S LOG=0 F S LOG=+$O(^EDP(230,LOG)) Q:LOG<1 D
. S IEN=0 F S IEN=+$O(^EDP(230,LOG,8,IEN)) Q:IEN<1 S ORD=+$G(^(IEN,0)) D
.. S:ORD ^EDP(230,"AO",ORD,LOG,IEN)=""
Q
CHOICES ; initialize choices timestamps
N AREA
S AREA=0 F S AREA=$O(^EDPB(231.9,AREA)) Q:'AREA S ^EDPB(231.9,AREA,231)=$H
Q
FIXNV ; convert the "no value" codes to 0
Q ; maybe do this later....
N NOVAL,LOG
S NOVAL=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
Q:'NOVAL
S LOG=0 F S LOG=$O(^EDP(230,LOG)) Q:'LOG D
. D CHGNV(230,LOG,0,10)
. D CHGNV(230,LOG,1,2)
. D CHGNV(230,LOG,1,5)
. D CHGNV(230,LOG,3,2)
. D CHGNV(230,LOG,3,3)
S LOG=0 F S LOG=$O(^EDP(230.1,LOG)) Q:'LOG D
. D CHGNV(230.1,LOG,0,10)
. D CHGNV(230.1,LOG,0,11)
. D CHGNV(230.1,LOG,0,12)
. D CHGNV(230.1,LOG,3,2)
. D CHGNV(230.1,LOG,3,3)
Q
CHGNV(FN,LOG,SUB,P) ; convert individual piece, expects NOVAL defined
Q ; maybe do this later....
I $P($G(^EDP(FN,LOG,SUB)),U,P)=NOVAL S $P(^EDP(FN,LOG,SUB),U,P)=0
Q
FIXAPX ; fix the AP xref in 230
I $$VERGTE^EDPYPRE(21) Q ; only convert if version <21
;
K ^EDP(230,"AP")
N DIK,DA
S DIK="^EDP(230,",DIK(1)=".06^AP"
D ENALL^DIK
Q
FIXPDFN ; create the DFN xref in 230
I $$VERGTE^EDPYPRE(24) Q ; only convert if last version <24
;
K ^EDP(230,"PDFN")
N DIK,DA
S DIK="^EDP(230,",DIK(1)=".06^PDFN"
D ENALL^DIK
Q
FIXSTA ; convert the station number field to an institution pointer
I $$VERGTE^EDPYPRE(22) Q ; only convert if version <22
;
N IEN
S IEN=0 F S IEN=$O(^EDP(230,IEN)) Q:'IEN D CHGSTA(230,IEN)
S IEN=0 F S IEN=$O(^EDPB(231.7,IEN)) Q:'IEN D CHGSTA(231.7,IEN)
S IEN=0 F S IEN=$O(^EDPB(231.8,IEN)) Q:'IEN D CHGSTA(231.8,IEN)
S IEN=0 F S IEN=$O(^EDPB(231.9,IEN)) Q:'IEN D CHGSTA(231.9,IEN)
D CLEAN^DILF
Q
CHGSTA(EDPFILE,EDPIEN) ; convert station number to institution pointer withing file
N STA,INST
S STA=$P($S(EDPFILE<231:^EDP(EDPFILE,EDPIEN,0),1:^EDPB(EDPFILE,EDPIEN,0)),U,2)
S INST=$$IEN^XUAF4(STA)
;
N FDA,DIERR,ERR
S FDA(EDPFILE,EDPIEN_",",.02)=INST
D FILE^DIE("","FDA","ERR")
I $D(DIERR) W !,"STA Error, File=",EDPFILE," IEN=",EDPIEN," STA=",STN," INST=",INST
Q
FIXICD ; convert the ICD Code file to a pointer to the ICD file
I $$VERGTE^EDPYPRE(22) Q ; only convert if version <22
;
N LOG,IEN
S LOG=0 F S LOG=$O(^EDP(230,LOG)) Q:'LOG D
. S IEN=0 F S IEN=$O(^EDP(230,LOG,4,IEN)) Q:'IEN D CHGICD(LOG,IEN)
D CLEAN^DILF
Q
CHGICD(LOG,IEN) ; convert individual ICD Code to ICD Pointer
N ICDCODE,ICDIEN
S ICDCODE=$P($P(^EDP(230,LOG,4,IEN,0),U,2),"/",1)
Q:'$L(ICDCODE)
S ICDIEN=+$O(^ICD9("BA",ICDCODE_" ",0))
;
N FDA,DIERR,ERR
S FDA(230.04,IEN_","_LOG_",",.02)=ICDIEN
D FILE^DIE("","FDA","ERR")
I $D(DIERR) W !,"STA Error, File=",EDPFILE," IEN=",EDPIEN," STA=",STN," INST=",INST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPYPST 6191 printed Dec 13, 2024@01:52:40 Page 2
EDPYPST ;SLC/KCM - Post init for facility install ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
+3 DO PROXY
DO CONVERT
DO FIXSPEC
DO FIXWAIT
DO FIXDFLT
DO AO
DO CHOICES
DO DELBRD
DO FIXAPX
DO FIXSTA
DO FIXICD
DO FIXPDFN
+4 KILL ^TMP("EDP-LAST-VERSION")
+5 QUIT
+6 ;
PROXY ; Create proxy user
+1 if $ORDER(^VA(200,"B","EDPTRACKING,PROXY",0))
QUIT
+2 NEW X
+3 SET X=$$CREATE^XUSAP("EDPTRACKING,PROXY","","EDPS BOARD CONTEXT")
+4 QUIT
+5 ;
CONVERT ; set ^XTMP for tracking conversion
+1 if '$DATA(^DIZ(172006,0))
QUIT
if $GET(^XTMP("EDP-CONV"))="DONE"
QUIT
+2 IF '$DATA(^XTMP("EDP-CONV"))
SET ^XTMP("EDP-CONV",0)=$$FMADD^XLFDT(DT,365)_U_DT_"^Copy ED data to EDIS files"
+3 ;old format
NEW I,DIV,X
SET X=$GET(^XTMP("EDP-CONV","X"))
+4 SET I=0
FOR
SET I=$ORDER(^DIZ(172012,I))
if I<1
QUIT
Begin DoDot:1
+5 SET DIV=$$DIV(I)
if 'DIV
QUIT
if $DATA(^XTMP("EDP-CONV","D",DIV))
QUIT
+6 NEW X1,X2,X3
SET (X2,X3)=0
+7 SET X1=$SELECT($LENGTH(X):"",1:I)
+8 ;old format - active done
if $PIECE(X,U,2)
SET X2=""
IF $PIECE(X,U,3)
SET X2=""
Begin DoDot:2
+9 NEW L
SET L=$PIECE(X,U,3)+1
+10 FOR
SET L=$ORDER(^DIZ(172006,L),-1)
if L<1
QUIT
IF +$GET(^(L,3))=DIV
SET X3=L
QUIT
End DoDot:2
+11 ; I^0^0
SET ^XTMP("EDP-CONV","D",DIV)=X1_U_X2_U_X3
End DoDot:1
+12 QUIT
DIV(X) ; return file 4 ien for Configuration
+1 NEW X0,Y
+2 SET X0=$GET(^DIZ(172012,+$GET(X),0))
SET Y=+X0
+3 IF Y<1
SET Y=+$SELECT($PIECE(X0,U,2):$PIECE(X0,U,2),1:$$SITE^VASITE)
+4 QUIT Y
+5 ;
FIXSPEC ; add the display properties to existing spec
+1 ; only convert if version <16
IF $$VERGTE^EDPYPRE(16)
QUIT
+2 ;
+3 NEW SPEC
+4 SET SPEC=0
FOR
SET SPEC=$ORDER(^EDPB(231.9,SPEC))
if 'SPEC
QUIT
DO ADDPROP(SPEC)
DO MOVEBRD(SPEC)
+5 QUIT
ADDPROP(SPEC) ; add display properties to spec
+1 NEW I,X,WP,ORIG,SKIP,DIERR
+2 SET SKIP=0
+3 SET I=0
FOR
SET I=$ORDER(^EDPB(231.9,SPEC,2,I))
if 'I
QUIT
Begin DoDot:1
+4 SET ORIG(I)=^EDPB(231.9,SPEC,2,I,0)
+5 IF ORIG(I)["displayProperties"
SET SKIP=1
End DoDot:1
+6 if SKIP
QUIT
+7 ;
+8 NEW LN
SET LN=0
+9 SET I=0
FOR
SET I=$ORDER(ORIG(I))
if 'I
QUIT
Begin DoDot:1
+10 SET LN=LN+1
SET WP(LN)=ORIG(I)
+11 IF ORIG(I)["<spec>"
SET LN=LN+1
SET WP(LN)=$PIECE($TEXT(DP+1),";",3,99)
End DoDot:1
+12 DO WP^DIE(231.9,SPEC_",",2,"","WP")
+13 DO CLEAN^DILF
+14 QUIT
MOVEBRD(AREA) ; move the display board spec into a multiple
+1 ; already entries in the multiple
IF $PIECE($GET(^EDPB(231.9,AREA,4,0)),U,4)
QUIT
+2 ; no spec to move
IF '$ORDER(^EDPB(231.9,AREA,2,0))
QUIT
+3 ;
+4 NEW I,X0,WP,MSG
+5 SET I=0
FOR
SET I=$ORDER(^EDPB(231.9,AREA,2,I))
if 'I
QUIT
Begin DoDot:1
+6 SET X0=^EDPB(231.9,AREA,2,I,0)
+7 if X0="<spec>"
QUIT
if X0="</spec>"
QUIT
+8 SET WP(I)=X0
End DoDot:1
+9 DO UPDBRD^EDPBCF(AREA,0,"Main (default)",.WP,.MSG)
+10 QUIT
DP ; default display properties
+1 ;;<displayProperties fontSize="10" displayWidth="1024" displayLabel="1024x768" scrollDelay="7" />
+2 ;
FIXWAIT ; change the category of waiting room to "waiting"
+1 ; only convert if version <14
IF $$VERGTE^EDPYPRE(14)
QUIT
+2 ;
+3 NEW IEN
+4 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(231.8,"B","Waiting",IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET $PIECE(^EDPB(231.8,IEN,0),U,9)=2
End DoDot:1
+6 QUIT
FIXDFLT ; create initial default rooms
+1 NEW AREA,X1,AMB,DFLT,STN
+2 SET AREA=0
FOR
SET AREA=$ORDER(^EDPB(231.9,AREA))
if 'AREA
QUIT
Begin DoDot:1
+3 SET X1=$GET(^EDPB(231.9,AREA,1))
SET AMB=$PIECE(X1,U,11)
SET DFLT=$PIECE(X1,U,12)
+4 SET STN=$PIECE(^EDPB(231.9,AREA,0),U,2)
+5 IF 'AMB
Begin DoDot:2
+6 SET AMB=$ORDER(^EDPB(231.8,"AC",STN,AREA,"AMBU",0))
+7 if AMB
SET $PIECE(^EDPB(231.9,AREA,1),U,11)=AMB
End DoDot:2
+8 IF 'DFLT
Begin DoDot:2
+9 SET DFLT=$ORDER(^EDPB(231.8,"AC",STN,AREA,"WAIT",0))
+10 SET $PIECE(^EDPB(231.9,AREA,1),U,12)=DFLT
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
DELBRD ; delete the DD and data for the old display board spec
+1 ; only convert if version <20
IF $$VERGTE^EDPYPRE(20)
QUIT
+2 ;
+3 IF $$GET1^DID(231.9,2,,"TYPE")'="WORD-PROCESSING"
QUIT
+4 NEW DIU
+5 SET DIU=231.92
SET DIU(0)="SD"
+6 DO EN^DIU2
+7 QUIT
AO ; build AO index on #230
+1 if $DATA(^EDP(230,"AO"))
QUIT
+2 NEW LOG,IEN,ORD
+3 SET LOG=0
FOR
SET LOG=+$ORDER(^EDP(230,LOG))
if LOG<1
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=+$ORDER(^EDP(230,LOG,8,IEN))
if IEN<1
QUIT
SET ORD=+$GET(^(IEN,0))
Begin DoDot:2
+5 if ORD
SET ^EDP(230,"AO",ORD,LOG,IEN)=""
End DoDot:2
End DoDot:1
+6 QUIT
CHOICES ; initialize choices timestamps
+1 NEW AREA
+2 SET AREA=0
FOR
SET AREA=$ORDER(^EDPB(231.9,AREA))
if 'AREA
QUIT
SET ^EDPB(231.9,AREA,231)=$HOROLOG
+3 QUIT
FIXNV ; convert the "no value" codes to 0
+1 ; maybe do this later....
QUIT
+2 NEW NOVAL,LOG
+3 SET NOVAL=+$ORDER(^EDPB(233.1,"B","edp.reserved.novalue",0))
+4 if 'NOVAL
QUIT
+5 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,LOG))
if 'LOG
QUIT
Begin DoDot:1
+6 DO CHGNV(230,LOG,0,10)
+7 DO CHGNV(230,LOG,1,2)
+8 DO CHGNV(230,LOG,1,5)
+9 DO CHGNV(230,LOG,3,2)
+10 DO CHGNV(230,LOG,3,3)
End DoDot:1
+11 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230.1,LOG))
if 'LOG
QUIT
Begin DoDot:1
+12 DO CHGNV(230.1,LOG,0,10)
+13 DO CHGNV(230.1,LOG,0,11)
+14 DO CHGNV(230.1,LOG,0,12)
+15 DO CHGNV(230.1,LOG,3,2)
+16 DO CHGNV(230.1,LOG,3,3)
End DoDot:1
+17 QUIT
CHGNV(FN,LOG,SUB,P) ; convert individual piece, expects NOVAL defined
+1 ; maybe do this later....
QUIT
+2 IF $PIECE($GET(^EDP(FN,LOG,SUB)),U,P)=NOVAL
SET $PIECE(^EDP(FN,LOG,SUB),U,P)=0
+3 QUIT
FIXAPX ; fix the AP xref in 230
+1 ; only convert if version <21
IF $$VERGTE^EDPYPRE(21)
QUIT
+2 ;
+3 KILL ^EDP(230,"AP")
+4 NEW DIK,DA
+5 SET DIK="^EDP(230,"
SET DIK(1)=".06^AP"
+6 DO ENALL^DIK
+7 QUIT
FIXPDFN ; create the DFN xref in 230
+1 ; only convert if last version <24
IF $$VERGTE^EDPYPRE(24)
QUIT
+2 ;
+3 KILL ^EDP(230,"PDFN")
+4 NEW DIK,DA
+5 SET DIK="^EDP(230,"
SET DIK(1)=".06^PDFN"
+6 DO ENALL^DIK
+7 QUIT
FIXSTA ; convert the station number field to an institution pointer
+1 ; only convert if version <22
IF $$VERGTE^EDPYPRE(22)
QUIT
+2 ;
+3 NEW IEN
+4 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,IEN))
if 'IEN
QUIT
DO CHGSTA(230,IEN)
+5 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(231.7,IEN))
if 'IEN
QUIT
DO CHGSTA(231.7,IEN)
+6 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(231.8,IEN))
if 'IEN
QUIT
DO CHGSTA(231.8,IEN)
+7 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(231.9,IEN))
if 'IEN
QUIT
DO CHGSTA(231.9,IEN)
+8 DO CLEAN^DILF
+9 QUIT
CHGSTA(EDPFILE,EDPIEN) ; convert station number to institution pointer withing file
+1 NEW STA,INST
+2 SET STA=$PIECE($SELECT(EDPFILE<231:^EDP(EDPFILE,EDPIEN,0),1:^EDPB(EDPFILE,EDPIEN,0)),U,2)
+3 SET INST=$$IEN^XUAF4(STA)
+4 ;
+5 NEW FDA,DIERR,ERR
+6 SET FDA(EDPFILE,EDPIEN_",",.02)=INST
+7 DO FILE^DIE("","FDA","ERR")
+8 IF $DATA(DIERR)
WRITE !,"STA Error, File=",EDPFILE," IEN=",EDPIEN," STA=",STN," INST=",INST
+9 QUIT
FIXICD ; convert the ICD Code file to a pointer to the ICD file
+1 ; only convert if version <22
IF $$VERGTE^EDPYPRE(22)
QUIT
+2 ;
+3 NEW LOG,IEN
+4 SET LOG=0
FOR
SET LOG=$ORDER(^EDP(230,LOG))
if 'LOG
QUIT
Begin DoDot:1
+5 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,LOG,4,IEN))
if 'IEN
QUIT
DO CHGICD(LOG,IEN)
End DoDot:1
+6 DO CLEAN^DILF
+7 QUIT
CHGICD(LOG,IEN) ; convert individual ICD Code to ICD Pointer
+1 NEW ICDCODE,ICDIEN
+2 SET ICDCODE=$PIECE($PIECE(^EDP(230,LOG,4,IEN,0),U,2),"/",1)
+3 if '$LENGTH(ICDCODE)
QUIT
+4 SET ICDIEN=+$ORDER(^ICD9("BA",ICDCODE_" ",0))
+5 ;
+6 NEW FDA,DIERR,ERR
+7 SET FDA(230.04,IEN_","_LOG_",",.02)=ICDIEN
+8 DO FILE^DIE("","FDA","ERR")
+9 IF $DATA(DIERR)
WRITE !,"STA Error, File=",EDPFILE," IEN=",EDPIEN," STA=",STN," INST=",INST
+10 QUIT
