- 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