source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCTU1.m@ 1432

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1GMRCTU1 ; SLC/KR Get DD Info ; [11/8/99 1:57pm]
2 ;;3.0;CONSULT/REQUEST TRACKING;**9**;Dec 27, 1997
3 ;
4INFO(FILE,FIELD,ORA) ;
5 ;
6 ; DIC Global Root for <FILE>
7 ; LOC Global Subscript Location (#;#) for <FIELD>
8 ;
9 ; INFO(<file #>,<field #>,.ARRAY)
10 ;
11 ; Returns
12 ;
13 ; ARRAY("DIC",0)=Global Root
14 ; ARRAY("DIC",1)=File Root
15 ; ARRAY("DIC",2)=Subfile Root
16 ; ARRAY("DIC",..)=Subfile Root
17 ; ARRAY("FILE")=Target File/Subfile Number
18 ; ARRAY("FIELD")=Target Field
19 ; ARRAY("NAME")=Target Field Name
20 ; ARRAY("LOC")=Subscript and Piece
21 ;
22 N DIC,LOC,SUB,SUBI,SFS,SNS S (DIC,LOC)="",FILE=+($G(FILE)),FIELD=+($G(FIELD))
23 Q:FILE=0!(FIELD=0) Q:'$D(^DD(FILE))
24 S ORA("FILE")=FILE,ORA("FIELD")=FIELD
25 D GETDD
26 S:$L(DIC) ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
27 S:$L($G(SFS)) ORA("DIC",1,"P")=SFS
28 S:$L(LOC) ORA("LOC")=LOC
29 Q
30GETDD ; Get file roots from DD
31 ;
32 ; FILE Current File #
33 ; FIELD Current Field #
34 ; DIC Current Global Root
35 ; LOC Current Global Subscript Location (#;#)
36 ; ARY( Temporay Storage Array (contains DD)
37 ; ORA( Output Array
38 ;
39 N ARY M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
40 M ARY(FILE,0,"UP")=^DD(FILE,0,"UP")
41 S ORA("NAME")=$P($G(ARY(FILE,FIELD,0)),"^",1)
42 S:'$L($G(LOC))&($D(ARY(FILE,FIELD,0))) LOC=$P(ARY(FILE,FIELD,0),"^",4)
43 D CURRDD:'$D(ARY(FILE,0,"UP")),NEXTDD:$D(ARY(FILE,0,"UP"))
44 Q
45CURRDD ; Current DD
46 ;
47 ; FILE Current File #
48 ; DIC Current Global Root
49 ; SFS Subfile Specifier Array
50 ; ARY( Temporary Storage Array (contains DD)
51 ;
52 S DIC=$$ROOT^DILFD(FILE,0,"GL")
53 S SFS=$P($$ROOT^DILFD(FILE,0),"^",2)
54 Q
55NEXTDD ; Next DD Level (for subfiles)
56 ;
57 ; OLDFILE Previous File #
58 ; OLDFIELD Previous Field #
59 ; OLDDIC Previous Global Root
60 ; OLDLOC Previous Global Subscript Location (#;#)
61 ; FILE Current File #
62 ; FIELD Current Field #
63 ; DIC Current Global Root
64 ; SNS Subfile Number and Subfile Specifier
65 ; LOC Current Global Subscript Location (#;#)
66 ; ARY( Temporay Storage Array (contains DD)
67 ; ORA( Output Array
68 ; SUB( Subscript Array
69 ; SFS( Subfile Specifier Array
70 ; SUBI Subscript Counter
71 ; SS Subscript
72 ; DA Internal Entry Number Array
73 ; CT1 Miscellaneous Counter #1
74 ; CT2 Miscellaneous Counter #2
75 ;
76 N FILE2,FIELD2,DIC2,LOC2,CT1,CT2
77 S LOC2=LOC,(FILE2,FIELD2)=FILE N FILE,FIELD,DIC
78 S FILE=$G(ARY(FILE2,0,"UP"))
79 N ARY M ARY(FILE,"SB",FIELD2)=^DD(FILE,"SB",FIELD2)
80 S FIELD=$O(ARY(FILE,"SB",FILE2,0))
81 M ARY(FILE,FIELD,0)=^DD(FILE,FIELD,0)
82 S SNS=$P($G(ARY(FILE,FIELD,0)),"^",2)
83 S SUBI=+($O(SUB(" "),-1)),SUBI=SUBI+1
84 S SUB(SUBI)=$P($P($G(ARY(FILE,FIELD,0)),"^",4),";",1),DIC=""
85 S SFS(SUBI)=SNS
86 D GETDD
87 S LOC=LOC2 I $L(DIC) D
88 . S ORA("DIC",0)=$P(DIC,"(",1)_"(",ORA("DIC",1)=DIC
89 . N DA,SS F CT1=SUBI:-1:1 S DA="DA("_CT1_")",DIC=DIC_DA_"," D
90 . . F CT2=SUBI:-1:1 D
91 . . . S SS=$G(SUB(CT2)),DIC=DIC_SS_",",ORA("DIC",(CT2+1))=DIC S:$L($G(SFS(CT2))) ORA("DIC",(CT2+1),"P")=$G(SFS(CT2))
92 Q
Note: See TracBrowser for help on using the repository browser.