Return to DIFROMSD.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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