BPMPRE ; IHS/OIT/NKD - Pre-install for BPM - 6/26/12 ;
;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
;
PRE ;
; CLEANUP PACKAGE FILE
D FIXPKG
; CORRECT DD ACCESS FOR PATIENT MERGE FILES
D FIXDD
; REMOVE ADDITIONAL ENTRIES IN THE DUPLICATE RESOLUTION FILE
D DEL151
; CORRECT VA PATIENT FILE ENTRY IN THE DUPLICATE RESOLUTION FILE
D MOD151
;
Q
FIXPKG ;
; REMOVE INVALID 'AFFECTS RECORD MERGE' ENTRIES FROM PACKAGE FILE
N IEN,DIK,DA
D BMES^XPDUTL("Cleaning Package file of 'AFFECTS RECORD MERGE' multiple...")
S IEN=0
F S IEN=$O(^DIC(9.4,IEN)) Q:'IEN D
. Q:$$GET1^DIQ(9.4,IEN,.01)="IHS PATIENT MERGE"
. I $D(^DIC(9.4,IEN,20)) D MES^XPDUTL("Found entry in Package: "_$$GET1^DIQ(9.4,IEN,.01)) K ^DIC(9.4,IEN,20)
;
; CLEAN 'AMRG' X-REF
K ^DIC(9.4,"AMRG")
N DIK S DIK="^DIC(9.4,DA(1),20,",DIK(1)=".01^AMRG"
S DA(1)=0
F S DA(1)=$O(^DIC(9.4,DA(1))) Q:'DA(1) D ENALL^DIK
Q
FIXDD ;
; FIX FILEMAN ACCESS ON BPM FILES
N SECURITY
D BMES^XPDUTL("Correcting Fileman access on Merge files...")
; DUPLICATE RECORD #15
K SECURITY D SETSEC("#","@","@","@","#","@",.SECURITY)
D FILESEC^DDMOD(15,.SECURITY)
; DUPLICATE RESOLUTION #15.1
K SECURITY D SETSEC("#","@","@","@","#","@",.SECURITY)
D FILESEC^DDMOD(15.1,.SECURITY)
; XDR MERGE PROCESS #15.2
K SECURITY D SETSEC("#","@","#","#","","#",.SECURITY)
D FILESEC^DDMOD(15.2,.SECURITY)
; XDR REPOINTED ENTRY #15.3
K SECURITY D SETSEC("#","@","#","#","","#",.SECURITY)
D FILESEC^DDMOD(15.3,.SECURITY)
; MERGE IMAGES #15.4
K SECURITY D SETSEC("@","@","@","@","@","@",.SECURITY)
D FILESEC^DDMOD(15.4,.SECURITY)
Q
DEL151 ;
; REMOVE ALL FILE #15.1 ENTRIES EXCEPT FOR THE VA PATIENT FILE #2
N BPMOUT,BPMCNT,I,DIK,DA
D BMES^XPDUTL("Checking file 15.1 for invalid entries...")
D LIST^DIC(15.1,,"@;.01I;.01","P",,,,,,,"BPMOUT",)
S BPMCNT=$P(BPMOUT("DILIST",0),"^",1)
F I=1:1:BPMCNT D
. Q:$P(BPMOUT("DILIST",I,0),"^",2)=2
. D BMES^XPDUTL(" Removing '"_$P(BPMOUT("DILIST",I,0),"^",3)_"'")
. S DIK="^VA(15.1,",DA=$P(BPMOUT("DILIST",I,0),"^",2) D ^DIK
Q
MOD151 ;
; CORRECT FILE #15.1 FIELDS FOR THE VA PATIENT FILE #2
N FDA,BPMOUT,I
D BMES^XPDUTL("Correcting VA PATIENT file entry in file 15.1...")
S FDA(15.1,"2,",.05)="BASIC"
S FDA(15.1,"2,",.06)="@"
S FDA(15.1,"2,",.09)="XDRPTCAN"
S FDA(15.1,"2,",.13)=0
S FDA(15.1,"2,",.14)=0
S FDA(15.1,"2,",.17)="@"
S FDA(15.1,"2,",.25)=0
S FDA(15.1,"2,",.26)="@"
S FDA(15.1,"2,",.27)="@"
S FDA(15.1,"2,",.28)="@"
S FDA(15.1,"2,",.31)="@"
S FDA(15.1,"2,",.32)="@"
S FDA(15.1,"2,",.33)="@"
S FDA(15.1,"2,",1.03)=180
D UPDATE^DIE(,"FDA",)
; REMOVE ENTRIES IN THE MULTIPLE FIELD 1200
D GETS^DIQ(15.1,2,"1200*",,"BPMOUT")
S I=""
F S I=$O(BPMOUT(15.112,I)) Q:'I D
.S BPMOUT(15.112,I,.01)="@"
D UPDATE^DIE(,"BPMOUT",)
Q
SETSEC(AUDIT,DD,DEL,LAYGO,RD,WR,SECURITY) ;
; CREATE VARIABLE FOR FILESEC^DDMOD
S SECURITY("AUDIT")=AUDIT
S SECURITY("DD")=DD
S SECURITY("DEL")=DEL
S SECURITY("LAYGO")=LAYGO
S SECURITY("RD")=RD
S SECURITY("WR")=WR
Q
BPMPRE ; IHS/OIT/NKD - Pre-install for BPM - 6/26/12 ;
+1 ;;1.0;IHS PATIENT MERGE;**2**;MAR 01, 2010;Build 1
+2 ;
PRE ;
+1 ; CLEANUP PACKAGE FILE
+2 DO FIXPKG
+3 ; CORRECT DD ACCESS FOR PATIENT MERGE FILES
+4 DO FIXDD
+5 ; REMOVE ADDITIONAL ENTRIES IN THE DUPLICATE RESOLUTION FILE
+6 DO DEL151
+7 ; CORRECT VA PATIENT FILE ENTRY IN THE DUPLICATE RESOLUTION FILE
+8 DO MOD151
+9 ;
+10 QUIT
FIXPKG ;
+1 ; REMOVE INVALID 'AFFECTS RECORD MERGE' ENTRIES FROM PACKAGE FILE
+2 NEW IEN,DIK,DA
+3 DO BMES^XPDUTL("Cleaning Package file of 'AFFECTS RECORD MERGE' multiple...")
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(^DIC(9.4,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 IF $$GET1^DIQ(9.4,IEN,.01)="IHS PATIENT MERGE"
QUIT
+7 IF $DATA(^DIC(9.4,IEN,20))
DO MES^XPDUTL("Found entry in Package: "_$$GET1^DIQ(9.4,IEN,.01))
KILL ^DIC(9.4,IEN,20)
End DoDot:1
+8 ;
+9 ; CLEAN 'AMRG' X-REF
+10 KILL ^DIC(9.4,"AMRG")
+11 NEW DIK
SET DIK="^DIC(9.4,DA(1),20,"
SET DIK(1)=".01^AMRG"
+12 SET DA(1)=0
+13 FOR
SET DA(1)=$ORDER(^DIC(9.4,DA(1)))
IF 'DA(1)
QUIT
DO ENALL^DIK
+14 QUIT
FIXDD ;
+1 ; FIX FILEMAN ACCESS ON BPM FILES
+2 NEW SECURITY
+3 DO BMES^XPDUTL("Correcting Fileman access on Merge files...")
+4 ; DUPLICATE RECORD #15
+5 KILL SECURITY
DO SETSEC("#","@","@","@","#","@",.SECURITY)
+6 DO FILESEC^DDMOD(15,.SECURITY)
+7 ; DUPLICATE RESOLUTION #15.1
+8 KILL SECURITY
DO SETSEC("#","@","@","@","#","@",.SECURITY)
+9 DO FILESEC^DDMOD(15.1,.SECURITY)
+10 ; XDR MERGE PROCESS #15.2
+11 KILL SECURITY
DO SETSEC("#","@","#","#","","#",.SECURITY)
+12 DO FILESEC^DDMOD(15.2,.SECURITY)
+13 ; XDR REPOINTED ENTRY #15.3
+14 KILL SECURITY
DO SETSEC("#","@","#","#","","#",.SECURITY)
+15 DO FILESEC^DDMOD(15.3,.SECURITY)
+16 ; MERGE IMAGES #15.4
+17 KILL SECURITY
DO SETSEC("@","@","@","@","@","@",.SECURITY)
+18 DO FILESEC^DDMOD(15.4,.SECURITY)
+19 QUIT
DEL151 ;
+1 ; REMOVE ALL FILE #15.1 ENTRIES EXCEPT FOR THE VA PATIENT FILE #2
+2 NEW BPMOUT,BPMCNT,I,DIK,DA
+3 DO BMES^XPDUTL("Checking file 15.1 for invalid entries...")
+4 DO LIST^DIC(15.1,,"@;.01I;.01","P",,,,,,,"BPMOUT",)
+5 SET BPMCNT=$PIECE(BPMOUT("DILIST",0),"^",1)
+6 FOR I=1:1:BPMCNT
Begin DoDot:1
+7 IF $PIECE(BPMOUT("DILIST",I,0),"^",2)=2
QUIT
+8 DO BMES^XPDUTL(" Removing '"_$PIECE(BPMOUT("DILIST",I,0),"^",3)_"'")
+9 SET DIK="^VA(15.1,"
SET DA=$PIECE(BPMOUT("DILIST",I,0),"^",2)
DO ^DIK
End DoDot:1
+10 QUIT
MOD151 ;
+1 ; CORRECT FILE #15.1 FIELDS FOR THE VA PATIENT FILE #2
+2 NEW FDA,BPMOUT,I
+3 DO BMES^XPDUTL("Correcting VA PATIENT file entry in file 15.1...")
+4 SET FDA(15.1,"2,",.05)="BASIC"
+5 SET FDA(15.1,"2,",.06)="@"
+6 SET FDA(15.1,"2,",.09)="XDRPTCAN"
+7 SET FDA(15.1,"2,",.13)=0
+8 SET FDA(15.1,"2,",.14)=0
+9 SET FDA(15.1,"2,",.17)="@"
+10 SET FDA(15.1,"2,",.25)=0
+11 SET FDA(15.1,"2,",.26)="@"
+12 SET FDA(15.1,"2,",.27)="@"
+13 SET FDA(15.1,"2,",.28)="@"
+14 SET FDA(15.1,"2,",.31)="@"
+15 SET FDA(15.1,"2,",.32)="@"
+16 SET FDA(15.1,"2,",.33)="@"
+17 SET FDA(15.1,"2,",1.03)=180
+18 DO UPDATE^DIE(,"FDA",)
+19 ; REMOVE ENTRIES IN THE MULTIPLE FIELD 1200
+20 DO GETS^DIQ(15.1,2,"1200*",,"BPMOUT")
+21 SET I=""
+22 FOR
SET I=$ORDER(BPMOUT(15.112,I))
IF 'I
QUIT
Begin DoDot:1
+23 SET BPMOUT(15.112,I,.01)="@"
End DoDot:1
+24 DO UPDATE^DIE(,"BPMOUT",)
+25 QUIT
SETSEC(AUDIT,DD,DEL,LAYGO,RD,WR,SECURITY) ;
+1 ; CREATE VARIABLE FOR FILESEC^DDMOD
+2 SET SECURITY("AUDIT")=AUDIT
+3 SET SECURITY("DD")=DD
+4 SET SECURITY("DEL")=DEL
+5 SET SECURITY("LAYGO")=LAYGO
+6 SET SECURITY("RD")=RD
+7 SET SECURITY("WR")=WR
+8 QUIT
