Return to DIFROMSD.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIFROMSD.m, revision 1.1

1.1     ! snw         1: DIFROMSD       ;SFISC/DCL-DIFROM SERVER DD LIST(KIDS/BUILD FILE);08:33 AM  6 Sep 1994;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: DD(DIFRFILE,DIFRFLG,DIFRTA)    ;FILENUMBER, TARGET ARRAY ROOT FOR SUB DD NRS
        !             6:        ;FILE, FLAGS, TARGET ARRAY
        !             7:        ;FILE = File number
        !             8:        ;FLAG = "W"  Include Word Processing DD numbers
        !             9:        ;DIFRTA = Target Array in closed array root format where informaiton
        !            10:        ;         is returned.
        !            11:        ;         Returns a list of sub DD numbers.  A flag allows wp DD
        !            12:        ;         numbers to also be returned.
        !            13:        N DIFRFD,DIFRFE,DIFRFW,DIFRNM,DIFRX
        !            14:        S DIFRFW=$G(DIFRFLG)'["W"
        !            15: F      S @DIFRTA@(DIFRFILE,DIFRFILE)=$O(^DD(DIFRFILE,0,"NM",""))_"  "_$S($D(^DIC(DIFRFILE,0)):"(File-top level)",1:"(sub-file)"),DIFRFE=0
        !            16: E      F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
        !            17:        .S DIFRFD=0
        !            18:        .F  S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0  D
        !            19:        ..I DIFRFW,$P(^DD(DIFRFD,.01,0),"^",2)["W" Q
        !            20:        ..I DIFRFILE-DIFRFE!'$D(DIFRFA) S @DIFRTA@(DIFRFILE,DIFRFD)=$O(^DD(DIFRFD,0,"NM",""))_"  (sub-file)"
        !            21:        ..Q
        !            22:        .Q
        !            23:        Q
        !            24:        ;
        !            25: DDIOLDD(DIFRFILE,DIFRFLG)      ;
        !            26:        ;FILE,FLAGS
        !            27:        ;FILE = File number
        !            28:        ;FLAGS = None
        !            29:        ;        Returns a list of all the valid DD numbers within a file
        !            30:        ;        via a call to DDIOL.
        !            31:        N I,X,Y
        !            32:        K ^TMP("DIFROMSP",$J)
        !            33:        D DD(DIFRFILE,"","^TMP(""DIFROMSP"",$J)")
        !            34:        S (I,X)=0 F  S I=$O(^TMP("DIFROMSP",$J,DIFRFILE,I)) Q:I'>0  S Y=^(I),X=X+1,^TMP("DIFROMSP",$J,"DDIOL",X,0)=I_$J("",(20-$L(I)))_Y
        !            35:        D EN^DDIOL("","^TMP(""DIFROMSP"",$J,""DDIOL"")")
        !            36:        K ^TMP("DIFROMSP",$J)
        !            37:        Q
        !            38:        ;
        !            39: CHKDD(DIFRFILE,DIFRDD,DIFRFLG) ;    $$    EXTRINSIC FUNCTION    $$
        !            40:        ;Extrinsic; Pass file and DD numbers returns 1 if OK
        !            41:        ; and 0 if not DD not part of File
        !            42:        ;FILE,DD#
        !            43:        ;FILE = File number
        !            44:        ;DD# = File or sub-file number.
        !            45:        ;      Used to determine if
        !            46:        ;      the value in DD# is valid for FILE.
        !            47:        ;FLAGS = "N"umber_"^"_"N"ame of field returned
        !            48:        ;        Default returns a 1 (true) or 0 (false).
        !            49:        Q:$G(DIFRDD)="" 0
        !            50:        Q:$G(DIFRFILE)="" 0
        !            51:        N DIFRARAY,N
        !            52:        S N=$G(DIFRFLG)["N"
        !            53:        D DD(DIFRFILE,"","DIFRARAY")
        !            54:        I $D(DIFRARAY(DIFRFILE,DIFRDD)) Q:N DIFRDD_"^"_DIFRARAY(DIFRFILE,DIFRDD) Q 1
        !            55:        Q 0
        !            56:        ;
        !            57: DDIOLFLD(DIFRDD,DIFRFLG)       ;
        !            58:        ;FILE/SUB_FILE,FLAGS
        !            59:        ;FILE = File or sub-file number
        !            60:        ;FLAGS = "M"ultiple fields excluded
        !            61:        ;        "W"ord processing fields excluded
        !            62:        ;        Returns a list of  valid field numbers within a file or
        !            63:        ;        sub-file via a call to DDIOL.
        !            64:        N I,M,W,X,Y,Z
        !            65:        S M=$G(DIFRFLG)["M",W=$G(DIFRFLG)["W"
        !            66:        K ^TMP("DIFROMSP",$J)
        !            67:        S (I,X)=0 F  S X=$O(^DD(DIFRDD,X)) Q:X'>0  S Y=$G(^(X,0)) D
        !            68:        .I $P(Y,"^",2) D  Q:Y=""
        !            69:        ..S Z=$P(^DD(+$P(Y,"^",2),.01,0),"^",2)
        !            70:        ..I M,Z'["W" S Y="" Q
        !            71:        ..I W,Z["W" S Y="" Q
        !            72:        ..S $P(Y,"^")=$P(Y,"^")_$S(Z["W":"  (word-processing)",1:"  (multiple)")
        !            73:        ..Q
        !            74:        .S I=I+1,^TMP("DIFROMSP",$J,I,0)=X_$J("",(12-$L(X)))_$P(Y,"^")
        !            75:        D EN^DDIOL("","^TMP(""DIFROMSP"",$J)")
        !            76:        K ^TMP("DIFROMSP",$J)
        !            77:        Q
        !            78:        ;
        !            79: FLDCHK(DIFRDD,DIFRFLD,DIFRFLG) ;     $$    EXTRINSIC FUNCTION     $$
        !            80:        ;Check if field exist; return 1/FIELD#_NAME, true, or 0, false.
        !            81:        ;FILE/SUB_FILE,FIELD,FLAGS
        !            82:        ;FILE/SUB_FILE = File or sub-file number
        !            83:        ;FIELD = Field number
        !            84:        ;        If FIELD is valid, returns 1; Otherwise 0 is returned.
        !            85:        ;FLAGS = "M"ultiple fields excluded
        !            86:        ;        "W"ord processing fields excluded
        !            87:        ;        "N"umber_"^"_"N"ame of field returned.
        !            88:        ;         Default is to return 1 or 0.
        !            89:        ;
        !            90:        Q:$G(DIFRDD)="" 0
        !            91:        Q:$G(DIFRFLD)="" 0
        !            92:        N M,N,W,Z
        !            93:        S M=$G(DIFRFLG)["M",W=$G(DIFRFLG)["W",N=$G(DIFRFLG)["N"
        !            94:        I $P($G(^DD(DIFRDD,DIFRFLD,0)),"^",2) S Z=$P(^DD(+$P(^(0),"^",2),.01,0),"^",2) D  Q:N $S(Z:DIFRFLD_"^"_$P(^DD(DIFRDD,DIFRFLD,0),"^"),1:Z) Q Z
        !            95:        .I M,Z'["W" S Z=0 Q
        !            96:        .I W,Z["W" S Z=0 Q
        !            97:        .S Z=1
        !            98:        .Q
        !            99:        I $D(^DD(DIFRDD,DIFRFLD,0))#2 Q:N DIFRFLD_"^"_$P(^(0),"^") Q 1
        !           100:        Q 0