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

DITMGMRG.m

Go to the documentation of this file.
  1. DITMGMRG ;SFISC/EDE(OHPRD)-RELINK/MERGE TWO ENTRIES BELOW POINTED TO FILE ;8MAR2006
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ; Merge two entries below pointed to file. See ^DITMDOC.
  1. ;
  1. START ;
  1. D ^DITMGM1
  1. I 'DITMGMRG("GO") D EOJ K DITMGMRG Q
  1. D EN
  1. K DITMGMRG
  1. Q
  1. ;
  1. EN ; EXTERNAL ENTRY POINT
  1. D INIT^DITMGMRI
  1. Q:$D(DITMGMQF)
  1. D STACK
  1. S:$D(DITMGMRG("NOTALK")) DITMGM2("NOTALK")=1
  1. D ^DITMGM2 K DITMGM2("NOTALK")
  1. K ^UTILITY("DITMGMRG",$J)
  1. W:'$D(DITMGMRG("NOTALK")) !!,"Merge complete",!!
  1. D EOJ
  1. Q
  1. ;
  1. STACK ;STACK ALL FILES POINTING TO POINTED TO FILE AND IF .01 FIELD
  1. ;POINTING AND DINUM, FILES POINTING TO POINTING FILE, AND SO ON.
  1. ;
  1. W:'$D(DITMGMRG("NOTALK")) !!,"Gathering files and checking 'PT' nodes"
  1. NEW DITMGFLE,DITMGPFL,DITMGPFD,DITMSKP
  1. K ^UTILITY("DITMGMRG",$J)
  1. S DITMGFLE=DITMGMRG("FILE")
  1. D FILES
  1. Q
  1. ;
  1. FILES ; CALLED RECURSIVELY
  1. D PTCHK
  1. F DITMGPFL=0:0 S DITMGPFL=$O(^DD(DITMGFLE,0,"PT",DITMGPFL)) Q:DITMGPFL'=+DITMGPFL D I 'DITMSKP D FIELDS
  1. . S DITMSKP=0
  1. . I $D(DITMGMRG("EXCLUDE",DITMGPFL)) S DITMSKP=1 Q
  1. . ;I DITMGFLE=DITMGPFL S DITMSKP=1 Q
  1. . Q:'$D(DITMGMRG("PACKAGE"))
  1. . I DITMGMRG("PACKAGE") S:'$D(DITMGMRG("PACKAGE",DITMGPFL)) DITMSKP=1 Q
  1. . Q
  1. Q
  1. ;
  1. FIELDS ;
  1. ;W:'$D(DITMGMRG("NOTALK")) "f"
  1. F DITMGPFD=0:0 S DITMGPFD=$O(^DD(DITMGFLE,0,"PT",DITMGPFL,DITMGPFD)) Q:DITMGPFD'=+DITMGPFD D
  1. IHS . I DITMGPFL=2,DITMGPFD=.082 Q ;NEW LINE
  1. . S ^UTILITY("DITMGMRG",$J,DITMGPFL,DITMGPFD)=DITMGFLE
  1. . ;W:'$D(DITMGMRG("NOTALK")) $S($D(^DD(DITMGPFL,0,"UP")):"s",1:".")
  1. . I DITMGPFD=.01,'$D(^DD(DITMGPFL,0,"UP")),$P(^DD(DITMGPFL,.01,0),U,5,99)["DINUM" D RECURSE
  1. Q
  1. ;
  1. RECURSE ;
  1. ;W:'$D(DITMGMRG("NOTALK")) "d"
  1. NEW DITMGFLE
  1. S DITMGFLE=DITMGPFL
  1. NEW DITMGPFL,DITMGPFD
  1. D FILES
  1. Q
  1. ;
  1. PTCHK ; MAKE SURE "PT" CORRECT
  1. I '$D(DITMGMRG("NOTALK")) ;W $S(DITMGMRG("FILE")=DITMGFLE:"",1:"[")
  1. E S DITMU4("NOTALK")=1
  1. S DITMU4FI=DITMGFLE
  1. F DITMU4PF=0:0 S DITMU4PF=$O(^DD(DITMU4FI,0,"PT",DITMU4PF)) Q:DITMU4PF="" F DITMU4PD=0:0 S DITMU4PD=$O(^DD(DITMU4FI,0,"PT",DITMU4PF,DITMU4PD)) Q:DITMU4PD="" D CHKIT^DITMU4
  1. K DITMU4FI,DITMU4L,DITMU4PF,DITMU4PD,DITMU4X,DITMU4("NOTALK")
  1. ;I DITMGMRG("FILE")'=DITMGFLE,'$D(DITMGMRG("NOTALK")) W "]"
  1. Q
  1. ;
  1. EOJ ;
  1. K X,Y
  1. K %,DIPGM
  1. I $D(DITMGMQF) S DITMGMRG("QFLG")=DITMGMQF
  1. K DITMGMF,DITMGMFG,DITMGMFL,DITMGMQF,DITMGMT
  1. K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. I $D(ZTSK) K ^%ZTSK(ZTSK),ZTSK Q ; old Kernel
  1. I '$D(DITMGMRG("NOTALK")),$D(DITMGMRG("ERROR")) D EOJ2 K DITMGMRG("ERROR")
  1. Q
  1. ;
  1. EOJ2 ; List errors
  1. W !!,"The following errors occurred during the merge: ",!
  1. F %=0:0 S %=$O(DITMGMRG("ERROR",%)) Q:%'=+% W !,DITMGMRG("ERROR",%)
  1. W !
  1. K %
  1. Q