Return to DIFROMSE.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIFROMSE.m, revision 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