Return to DIFROMSE.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIFROMSE	;SFISC/DCL-FILE ORDER TO RESOLVE POINTERS;07:27 AM  2 Jun 1994;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	Q
    5: 	;File Order List for Resolving Pointers
    6: FOLRP(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
   46: P	...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
   64: KILL	;
   65: 	K ^TMP("DIFROMSE",$J),^TMP("DIFRORD",$J),^TMP("DIFRFILE",$J)
   66: 	Q
   67: 	;
   68: CHK(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