Return to DITMGMRG.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DITMGMRG	;SFISC/EDE(OHPRD)-RELINK/MERGE TWO ENTRIES BELOW POINTED TO FILE ;2/24/94  16:10
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: 	; Merge two entries below pointed to file.  See ^DITMDOC.
    6: 	;
    7: START	;
    8: 	D ^DITMGM1
    9: 	I 'DITMGMRG("GO") D EOJ K DITMGMRG Q
   10: 	D EN
   11: 	K DITMGMRG
   12: 	Q
   13: 	;
   14: EN	; EXTERNAL ENTRY POINT
   15: 	D INIT^DITMGMRI
   16: 	Q:$D(DITMGMQF)
   17: 	D STACK
   18: 	S:$D(DITMGMRG("NOTALK")) DITMGM2("NOTALK")=1
   19: 	D ^DITMGM2 K DITMGM2("NOTALK")
   20: 	K ^UTILITY("DITMGMRG",$J)
   21: 	W:'$D(DITMGMRG("NOTALK")) !!,"Merge complete",!!
   22: 	D EOJ
   23: 	Q
   24: 	;
   25: STACK	;STACK ALL FILES POINTING TO POINTED TO FILE AND IF .01 FIELD
   26: 	;POINTING AND DINUM, FILES POINTING TO POINTING FILE, AND SO ON.
   27: 	;
   28: 	W:'$D(DITMGMRG("NOTALK")) !!,"Gathering files and checking 'PT' nodes"
   29: 	NEW DITMGFLE,DITMGPFL,DITMGPFD,DITMSKP
   30: 	K ^UTILITY("DITMGMRG",$J)
   31: 	S DITMGFLE=DITMGMRG("FILE")
   32: 	D FILES
   33: 	Q
   34: 	;
   35: FILES	; CALLED RECURSIVELY
   36: 	D PTCHK
   37: 	F DITMGPFL=0:0 S DITMGPFL=$O(^DD(DITMGFLE,0,"PT",DITMGPFL)) Q:DITMGPFL'=+DITMGPFL  D  I 'DITMSKP D FIELDS
   38: 	. S DITMSKP=0
   39: 	. I $D(DITMGMRG("EXCLUDE",DITMGPFL)) S DITMSKP=1 Q
   40: 	. ;I DITMGFLE=DITMGPFL S DITMSKP=1 Q
   41: 	. Q:'$D(DITMGMRG("PACKAGE"))
   42: 	. I DITMGMRG("PACKAGE") S:'$D(DITMGMRG("PACKAGE",DITMGPFL)) DITMSKP=1 Q
   43: 	. Q
   44: 	Q
   45: 	;
   46: FIELDS	;
   47: 	;W:'$D(DITMGMRG("NOTALK")) "f"
   48: 	F DITMGPFD=0:0 S DITMGPFD=$O(^DD(DITMGFLE,0,"PT",DITMGPFL,DITMGPFD)) Q:DITMGPFD'=+DITMGPFD  D
   49: 	. S ^UTILITY("DITMGMRG",$J,DITMGPFL,DITMGPFD)=DITMGFLE
   50: 	. ;W:'$D(DITMGMRG("NOTALK")) $S($D(^DD(DITMGPFL,0,"UP")):"s",1:".")
   51: 	. I DITMGPFD=.01,'$D(^DD(DITMGPFL,0,"UP")),$P(^DD(DITMGPFL,.01,0),U,5,99)["DINUM" D RECURSE
   52: 	Q
   53: 	;
   54: RECURSE	;
   55: 	;W:'$D(DITMGMRG("NOTALK")) "d"
   56: 	NEW DITMGFLE
   57: 	S DITMGFLE=DITMGPFL
   58: 	NEW DITMGPFL,DITMGPFD
   59: 	D FILES
   60: 	Q
   61: 	;
   62: PTCHK	; MAKE SURE "PT" CORRECT
   63: 	I '$D(DITMGMRG("NOTALK")) ;W $S(DITMGMRG("FILE")=DITMGFLE:"",1:"[")
   64: 	E  S DITMU4("NOTALK")=1
   65: 	S DITMU4FI=DITMGFLE
   66: 	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
   67: 	K DITMU4FI,DITMU4L,DITMU4PF,DITMU4PD,DITMU4X,DITMU4("NOTALK")
   68: 	;I DITMGMRG("FILE")'=DITMGFLE,'$D(DITMGMRG("NOTALK")) W "]"
   69: 	Q
   70: 	;
   71: EOJ	;
   72: 	K X,Y
   73: 	K %,DIPGM
   74: 	I $D(DITMGMQF) S DITMGMRG("QFLG")=DITMGMQF
   75: 	K DITMGMF,DITMGMFG,DITMGMFL,DITMGMQF,DITMGMT
   76: 	K AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX
   77: 	I $D(ZTQUEUED) S ZTREQ="@" Q
   78: 	I $D(ZTSK) K ^%ZTSK(ZTSK),ZTSK Q  ; old Kernel
   79: 	I '$D(DITMGMRG("NOTALK")),$D(DITMGMRG("ERROR")) D EOJ2 K DITMGMRG("ERROR")
   80: 	Q
   81: 	;
   82: EOJ2	; List errors
   83: 	W !!,"The following errors occurred during the merge: ",!
   84: 	F %=0:0 S %=$O(DITMGMRG("ERROR",%)) Q:%'=+%  W !,DITMGMRG("ERROR",%)
   85: 	W !
   86: 	K %
   87: 	Q