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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DIFROMSE ;SFISC/DCL-FILE ORDER TO RESOLVE POINTERS ;07:27 AM 2 Jun 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;File Order List for Resolving Pointers
6FOLRP(DIFRFLG,DIFRTA) ;FLAGS,TARGET_ARRAY ; Creates the "DIORD" subscript
7 ; structure in the transport array.
8 ;FLAGS,TARGET_ARRAY
9 ;*
10 ;FLAGS = None
11 ;*
12 ;TARGET_ARRAY = CLOSED ROOT
13 ; This is the Transport Array Root.
14 ; "DIORD" is appended to the array root.
15 ; A ordered list of files is returned
16 ; in the target array. Each file is given
17 ; a value to determine which file should have
18 ; pointers resolved. After each file has been
19 ; assigned a value it is ordered by value then
20 ; by file number. If files have the same value
21 ; the file number is then used to determine the
22 ; order. This call is used after all the file
23 ; being transported are in the "FIA" structure.
24 ;*
25 Q:$G(DIFRTA)']""
26 N DIFRCNT,DIFRDD,DIFRF,DIFRFILE,DIFRFLD,DIFRX
27 S DIFRFILE=0
28 K ^TMP("DIFROMSE",$J),^TMP("DIFRORD",$J),^TMP("DIFRFILE",$J),@DIFRTA@("DIORD")
29 F S DIFRFILE=$O(@DIFRTA@("FIA",DIFRFILE)) Q:DIFRFILE'>0 D
30 .D FSF^DIFROMSP(DIFRFILE,"","^TMP(""DIFROMSE"",$J)")
31 .Q
32 S DIFRFILE=0
33 F S DIFRFILE=$O(^TMP("DIFROMSE",$J,DIFRFILE)) Q:DIFRFILE'>0 D
34 .S DIFRDD=0,^TMP("DIFRORD",$J,DIFRFILE)=0
35 .F S DIFRDD=$O(^TMP("DIFROMSE",$J,DIFRFILE,DIFRDD)) Q:DIFRDD'>0 D
36 ..S DIFRFLD=0
37 ..F S DIFRFLD=$O(^DD(DIFRDD,DIFRFLD)) Q:DIFRFLD'>0 S DIFRX=$G(^(DIFRFLD,0)) D
38 ...Q:$P(DIFRX,"^",2)
39 ...Q:$P(DIFRX,"^",2)'["P"&($P(DIFRX,"^")'["V")
40 ...S DIFRCNT=0
41 ...I $P(DIFRX,"^",2)["V" D G P
42 ....S DIFRF=0 F S DIFRF=$O(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF)) Q:DIFRF'>0 S ^TMP("DIFRFILE",$J,DIFRF)=DIFRCNT+1
43 ....Q
44 ...I +$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2)=DIFRFILE S:$G(^TMP("DIFRORD",$J,DIFRFILE))'>DIFRCNT ^(DIFRFILE)=DIFRCNT Q
45 ...I $P(DIFRX,"^",2)["P" S ^TMP("DIFRFILE",$J,+$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1
46P ...S DIFRF=$O(^TMP("DIFRFILE",$J,"")) Q:DIFRF="" S DIFRCNT=^(DIFRF) K ^(DIFRF)
47 ...I $G(^TMP("DIFRORD",$J,DIFRF))'>DIFRCNT S ^(DIFRF)=DIFRCNT
48 ...S DIFRX=^DD(DIFRF,.01,0)
49 ...I $P(DIFRX,"^",2)["P" S ^TMP("DIFRFILE",$J,+$P(@("^"_$P(DIFRX,"^",3)_"0)"),"^",2))=DIFRCNT+1 G P
50 ...G:$P(DIFRX,"^",2)'["V" P
51 ...S DIFRF=0 F S DIFRF=$O(^DD(DIFRDD,DIFRFLD,"V","B",DIFRF)) Q:DIFRF'>0 S ^TMP("DIFRFILE",$J,DIFRF)=DIFRCNT
52 ...S DIFRCNT=DIFRCNT+1
53 ...G P
54 ...Q
55 ..Q
56 .Q
57 S DIFRFILE=0
58 F S DIFRFILE=$O(^TMP("DIFRORD",$J,DIFRFILE)) Q:DIFRFILE'>0 S DIFRX=^(DIFRFILE),^TMP("DIFRORD",$J,"DIORD",DIFRX,DIFRFILE)=""
59 S DIFRX="",DIFRCNT=1 F S DIFRX=$O(^TMP("DIFRORD",$J,"DIORD",DIFRX),-1) Q:DIFRX="" D
60 .S DIFRFILE=0 F S DIFRFILE=$O(^TMP("DIFRORD",$J,"DIORD",DIFRX,DIFRFILE)) Q:DIFRFILE'>0 D
61 ..S @DIFRTA@("DIORD",DIFRCNT)=DIFRFILE,DIFRCNT=DIFRCNT+1
62 D KILL
63 Q
64KILL ;
65 K ^TMP("DIFROMSE",$J),^TMP("DIFRORD",$J),^TMP("DIFRFILE",$J)
66 Q
67 ;
68CHK(DIFRFLG,DIFRSA,DIFRTA) ;CHECK FILES POINTED TO AGAINST FILES GOING OUT WITH DATA
69 ;Compares the "DIORD" with the "FIA" structures
70 ;FLAGS,SOURCE_ARRAY,TARGET_ARRAY
71 ;*
72 ;FLAGS = None
73 ;*
74 ;SOURCE_ARRAY = TRANSPORT ARRAY ROOT
75 ;*
76 ;TARGET_ARRAY = TARGET ARRAY ROOT
77 ; Returns a list of files that are pointed to
78 ; but not being exported. This is used after
79 ; all the files being exported are in the "FIA"
80 ; structure.
81 ;*
82 Q:$G(DIFRSA)']""
83 Q:$G(DIFRTA)']""
84 N DIFRX,DIFRFILE
85 S DIFRX=0
86 F S DIFRX=$O(@DIFRSA@("DIORD",DIFRX)) Q:DIFRX'>0 S DIFRFILE=^(DIFRX) D
87 .Q:$D(@DIFRSA@("DATA",DIFRFILE))&($P($G(@DIFRSA@("FIA",DIFRFILE,0,1)),"^",5)="y")
88 .S @DIFRTA@(DIFRFILE)=""
89 .Q
90 Q
Note: See TracBrowser for help on using the repository browser.