| 1 | DITMGMRG ;SFISC/EDE(OHPRD)-RELINK/MERGE TWO ENTRIES BELOW POINTED TO FILE ;2/24/94 16:10
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
