source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DITMGMRG.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1DITMGMRG ;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 ;
7START ;
8 D ^DITMGM1
9 I 'DITMGMRG("GO") D EOJ K DITMGMRG Q
10 D EN
11 K DITMGMRG
12 Q
13 ;
14EN ; 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 ;
25STACK ;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 ;
35FILES ; 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 ;
46FIELDS ;
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 ;
54RECURSE ;
55 ;W:'$D(DITMGMRG("NOTALK")) "d"
56 NEW DITMGFLE
57 S DITMGFLE=DITMGPFL
58 NEW DITMGPFL,DITMGPFD
59 D FILES
60 Q
61 ;
62PTCHK ; 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 ;
71EOJ ;
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 ;
82EOJ2 ; 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
Note: See TracBrowser for help on using the repository browser.