Return to DIFROMSE.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIFROMSE.m, revision 1.1.1.1

1.1       snw         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