Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPYPST

EDPYPST.m

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