source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFROMSD.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DIFROMSD ;SFISC/DCL-DIFROM SERVER DD LIST(KIDS/BUILD FILE) ;08:33 AM 6 Sep 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5DD(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"
15F S @DIFRTA@(DIFRFILE,DIFRFILE)=$O(^DD(DIFRFILE,0,"NM",""))_" "_$S($D(^DIC(DIFRFILE,0)):"(File-top level)",1:"(sub-file)"),DIFRFE=0
16E 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 ;
25DDIOLDD(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 ;
39CHKDD(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 ;
57DDIOLFLD(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 ;
79FLDCHK(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
Note: See TracBrowser for help on using the repository browser.