Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIFROMSD

DIFROMSD.m

Go to the documentation of this file. 
  1. DIFROMSD ;SFISC/DCL-DIFROM SERVER DD LIST(KIDS/BUILD FILE) ;08:33 AM  6 Sep 1994
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. DD(DIFRFILE,DIFRFLG,DIFRTA) ;FILENUMBER, TARGET ARRAY ROOT FOR SUB DD NRS
  1.  ;FILE, FLAGS, TARGET ARRAY
  1.  ;FILE = File number
  1.  ;FLAG = "W"  Include Word Processing DD numbers
  1.  ;DIFRTA = Target Array in closed array root format where informaiton
  1.  ;         is returned.
  1.  ;         Returns a list of sub DD numbers.  A flag allows wp DD
  1.  ;         numbers to also be returned.
  1.  N DIFRFD,DIFRFE,DIFRFW,DIFRNM,DIFRX
  1.  S DIFRFW=$G(DIFRFLG)'["W"
  1. F S @DIFRTA@(DIFRFILE,DIFRFILE)=$O(^DD(DIFRFILE,0,"NM",""))_"  "_$S($D(^DIC(DIFRFILE,0)):"(File-top level)",1:"(sub-file)"),DIFRFE=0
  1. E F  S DIFRFE=$O(@DIFRTA@(DIFRFILE,DIFRFE)) Q:DIFRFE'>0  D
  1.  .S DIFRFD=0
  1.  .F  S DIFRFD=$O(^DD(DIFRFE,"SB",DIFRFD)) Q:DIFRFD'>0  D
  1.  ..I DIFRFW,$P(^DD(DIFRFD,.01,0),"^",2)["W" Q
  1.  ..I DIFRFILE-DIFRFE!'$D(DIFRFA) S @DIFRTA@(DIFRFILE,DIFRFD)=$O(^DD(DIFRFD,0,"NM",""))_"  (sub-file)"
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. DDIOLDD(DIFRFILE,DIFRFLG) ;
  1.  ;FILE,FLAGS
  1.  ;FILE = File number
  1.  ;FLAGS = None
  1.  ;        Returns a list of all the valid DD numbers within a file
  1.  ;        via a call to DDIOL.
  1.  N I,X,Y
  1.  K ^TMP("DIFROMSP",$J)
  1.  D DD(DIFRFILE,"","^TMP(""DIFROMSP"",$J)")
  1.  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
  1.  D EN^DDIOL("","^TMP(""DIFROMSP"",$J,""DDIOL"")")
  1.  K ^TMP("DIFROMSP",$J)
  1.  Q
  1.  ;
  1. CHKDD(DIFRFILE,DIFRDD,DIFRFLG) ;    $$    EXTRINSIC FUNCTION    $$
  1.  ;Extrinsic; Pass file and DD numbers returns 1 if OK
  1.  ; and 0 if not DD not part of File
  1.  ;FILE,DD#
  1.  ;FILE = File number
  1.  ;DD# = File or sub-file number.
  1.  ;      Used to determine if
  1.  ;      the value in DD# is valid for FILE.
  1.  ;FLAGS = "N"umber_"^"_"N"ame of field returned
  1.  ;        Default returns a 1 (true) or 0 (false).
  1.  Q:$G(DIFRDD)="" 0
  1.  Q:$G(DIFRFILE)="" 0
  1.  N DIFRARAY,N
  1.  S N=$G(DIFRFLG)["N"
  1.  D DD(DIFRFILE,"","DIFRARAY")
  1.  I $D(DIFRARAY(DIFRFILE,DIFRDD)) Q:N DIFRDD_"^"_DIFRARAY(DIFRFILE,DIFRDD) Q 1
  1.  Q 0
  1.  ;
  1. DDIOLFLD(DIFRDD,DIFRFLG) ;
  1.  ;FILE/SUB_FILE,FLAGS
  1.  ;FILE = File or sub-file number
  1.  ;FLAGS = "M"ultiple fields excluded
  1.  ;        "W"ord processing fields excluded
  1.  ;        Returns a list of  valid field numbers within a file or
  1.  ;        sub-file via a call to DDIOL.
  1.  N I,M,W,X,Y,Z
  1.  S M=$G(DIFRFLG)["M",W=$G(DIFRFLG)["W"
  1.  K ^TMP("DIFROMSP",$J)
  1.  S (I,X)=0 F  S X=$O(^DD(DIFRDD,X)) Q:X'>0  S Y=$G(^(X,0)) D
  1.  .I $P(Y,"^",2) D  Q:Y=""
  1.  ..S Z=$P(^DD(+$P(Y,"^",2),.01,0),"^",2)
  1.  ..I M,Z'["W" S Y="" Q
  1.  ..I W,Z["W" S Y="" Q
  1.  ..S $P(Y,"^")=$P(Y,"^")_$S(Z["W":"  (word-processing)",1:"  (multiple)")
  1.  ..Q
  1.  .S I=I+1,^TMP("DIFROMSP",$J,I,0)=X_$J("",(12-$L(X)))_$P(Y,"^")
  1.  D EN^DDIOL("","^TMP(""DIFROMSP"",$J)")
  1.  K ^TMP("DIFROMSP",$J)
  1.  Q
  1.  ;
  1. FLDCHK(DIFRDD,DIFRFLD,DIFRFLG) ;     $$    EXTRINSIC FUNCTION     $$
  1.  ;Check if field exist; return 1/FIELD#_NAME, true, or 0, false.
  1.  ;FILE/SUB_FILE,FIELD,FLAGS
  1.  ;FILE/SUB_FILE = File or sub-file number
  1.  ;FIELD = Field number
  1.  ;        If FIELD is valid, returns 1; Otherwise 0 is returned.
  1.  ;FLAGS = "M"ultiple fields excluded
  1.  ;        "W"ord processing fields excluded
  1.  ;        "N"umber_"^"_"N"ame of field returned.
  1.  ;         Default is to return 1 or 0.
  1.  ;
  1.  Q:$G(DIFRDD)="" 0
  1.  Q:$G(DIFRFLD)="" 0
  1.  N M,N,W,Z
  1.  S M=$G(DIFRFLG)["M",W=$G(DIFRFLG)["W",N=$G(DIFRFLG)["N"
  1.  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
  1.  .I M,Z'["W" S Z=0 Q
  1.  .I W,Z["W" S Z=0 Q
  1.  .S Z=1
  1.  .Q
  1.  I $D(^DD(DIFRDD,DIFRFLD,0))#2 Q:N DIFRFLD_"^"_$P(^(0),"^") Q 1
  1.  Q 0