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

BPMPRE.m

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