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

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1DITMGM2B ;SFISC/EDE(OHPRD),TKW-CONTINUATION OF DITMGM2 ;4/7/94 10:09
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6SEARCH ; $O THRU DATA GBL
7 Q:'$O(@(DITMGMG_"0)"))
8 W:'$D(DITMGM2("NOTALK")) !,"No REGULAR xref on ",DITMGMFL,",",DITMGMFD,". ",+$P(^(0),U,4)," entries. Searching data global."
9 F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMG_DITMGMN_")")) Q:DITMGMN'=+DITMGMN D
10 . I DITMGMMU D SEARCHM Q
11 . I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY
12 . Q
13 Q
14 ;
15SEARCHM ; $O THRU DATA GBL FOR MULTIPLES (TOP)
16 S DITMGMDN=+$P(DITMGMGM,"DA(",2)
17 S DA(DITMGMDN)=DITMGMN,DITMGDA(DITMGMDN)=DITMGMN
18 S DITMGMGG=$P(DITMGMGM,"DA(",1)_"DA("_DITMGMDN_"),"
19 S DITMGMDN=DITMGMDN-1
20 NEW DITMGMN
21 D SEARCHM2
22 K DA,DITMGDA,DITMGMGG
23 Q
24 ;
25SEARCHM2 ; MIDDLE (CALLED RECURSIVELY)
26 I '$F(DITMGMGM,"DA("_DITMGMDN_"),") D SEARCHM3 Q
27 S DITMGMGG=$P(DITMGMGM,",DA("_DITMGMDN_"),",1)_","
28 F DITMGDA(DITMGMDN)=0:0 S DITMGDA(DITMGMDN)=$O(@(DITMGMGG_DITMGDA(DITMGMDN)_")")) Q:DITMGDA(DITMGMDN)'=+DITMGDA(DITMGMDN) S DA(DITMGMDN)=DITMGDA(DITMGMDN) D SEARCHM4
29 Q
30 ;
31SEARCHM3 ; BOTTOM
32 D SETDA
33 F DITMGMN=0:0 S DITMGMN=$O(@(DITMGMGM_DITMGMN_")")) Q:DITMGMN'=+DITMGMN I $D(^(DITMGMN,DITMGMNO)),$P(^(DITMGMNO),U,DITMGMPC)=DITMGMF D ENTRY,SETDA
34 Q
35 ;
36SETDA ; SET DA ARRAY
37 K DA
38 F I=1:1 Q:'$D(DITMGDA(I)) S DA(I)=DITMGDA(I)
39 Q
40 ;
41SEARCHM4 ; RECURSE
42 S DITMGMDN=DITMGMDN-1
43 D SEARCHM2
44 S DITMGMDN=DITMGMDN+1
45 Q
46 ;
47ENTRY ; PROCESS ONE FILE/SUBFILE ENTRY
48 D ENTRY^DITMGM2C
49 Q
50 ;
51INIT ;
52 K DITMGMQF
53 K DITMGMRG("ERROR") S DITMGMEC=0
54 S:$D(ZTQUEUED) DITMGM2("NOTALK")=1
55 S:$D(ZTSK) DITMGM2("NOTALK")=1 ; old Kernel
56 I '$D(DITMGMFL) S DITMGMQF=20 Q
57 I 'DITMGMFL S DITMGMQF=20 Q
58 I '$D(^DIC(DITMGMFL,0,"GL")) S DITMGMQF=20 Q
59 S DITMGMFG=^("GL")
60 I '$D(DITMGMF)!('$D(DITMGMT)) S DITMGMQF=21 Q
61 I 'DITMGMF!('DITMGMT)!(DITMGMF=DITMGMT) S DITMGMQF=22 Q
62 I '$D(@(DITMGMFG_DITMGMF_",0)")) S DITMGMQF=23 Q
63 I '$D(@(DITMGMFG_DITMGMT_",0)")) S DITMGMQF=24 Q
64 Q
Note: See TracBrowser for help on using the repository browser.