source: FOIAVistA/trunk/r/NOIS-FSC/FSCRPCLS.m@ 1288

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1FSCRPCLS ;SLC/STAFF-NOIS RPC List Short ;7/23/98 14:17
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
5 N DIR,FILE,FROM,LINE,NUM
6 S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1)),FILE=$P(LINE,U),FROM=$P(LINE,U,2),DIR=$P(LINE,U,3)
7 I '$L(FILE) Q
8 I FILE="STATUS" D STATUS Q
9 I FILE="SSTATUS" D SSTATUS Q
10 I FILE="RSTATUS" D RSTATUS Q
11 I FILE="SPEC" D SPEC Q
12 I FILE="PRI" D PRI Q
13 I $E(FILE,1,3)="SUB" D Q
14 .I $P(FILE,";",2) D SUBPACK(+$P(FILE,";",2)) Q
15 .D SUB Q
16 I FILE="ISC" D ISC Q
17 I FILE="FUNC" D FUNC Q
18 I FILE="TASK" D TASK Q
19 I FILE="LTYPE" D LTYPE Q
20 I FILE="PACKGP" D PACKGP Q
21 I FILE="VISN" D VISN Q
22 I FILE="EPTYPE" D EPTYPE Q
23 I FILE="SYSTEM" D SYSTEM Q
24 I FILE="FIELD" D FIELD Q
25 I FILE="FORMAT_SORT" D SORT Q
26 I FILE="FORMAT_DISPLAY" D DISPLAY Q
27 I FILE="USER_AFFIL" D UPACK Q
28 I FILE="USER_FORMAT_SORT" D USORT Q
29 I FILE="USER_FORMAT_DISPLAY" D UDISPLAY Q
30 I FILE="COMMON_LISTS" D CLISTS Q
31 I $P(FILE,";")="USER_LISTS" D ULISTS Q
32 I $E(FILE,1,3)="WEB" D WEB(+$P(FILE,";",2)) Q
33 Q
34 ;
35SSTATUS ;
36 N FROM,IEN,NUM S NUM=0
37 S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
38 .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
39 ..I $P($G(^FSC("STATUS",IEN,0)),U,2)="D" Q
40 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
41 Q
42 ;
43RSTATUS ;
44 N FROM,IEN,NUM S NUM=0
45 S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
46 .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
47 ..I $P($G(^FSC("STATUS",IEN,0)),U,2)="S" Q
48 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
49 Q
50 ;
51STATUS ;
52 N FROM,IEN,NUM S NUM=0
53 S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
54 .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
55 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
56 Q
57 ;
58SPEC ;
59 K ^TMP("FSC SPEC",$J)
60 N FROM,IEN,NUM,ZERO S NUM=0
61 S IEN=0 F S IEN=$O(^FSC("SPEC",IEN)) Q:IEN<1 S ZERO=$G(^(IEN,0)) I $L(ZERO),'$P(ZERO,U,2) D
62 .S NAME=$P($G(^VA(200,IEN,0)),U) I $P($G(^(0)),U,11),$P($G(^(0)),U,11)<DT Q
63 .I $L(NAME) S ^TMP("FSC SPEC",$J,NAME,IEN)=NAME_U_$P(ZERO,U,2,99)
64 S FROM="" F S FROM=$O(^TMP("FSC SPEC",$J,FROM)) Q:FROM="" D
65 .S IEN=0 F S IEN=$O(^TMP("FSC SPEC",$J,FROM,IEN)) Q:'IEN D
66 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_^TMP("FSC SPEC",$J,FROM,IEN)
67 K ^TMP("FSC SPEC",$J)
68 Q
69 ;
70PRI ;
71 N FROM,IEN,NUM S NUM=0
72 S FROM="" F S FROM=$O(^FSC("PRI","B",FROM)) Q:FROM="" D
73 .S IEN=0 F S IEN=$O(^FSC("PRI","B",FROM,IEN)) Q:'IEN D
74 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PRI",IEN,0))
75 Q
76 ;
77SUB ;
78 N FROM,IEN,NUM,PACK,PACKNAME S NUM=0
79 S FROM="" F S FROM=$O(^FSC("SUB","B",FROM)) Q:FROM="" D
80 .S IEN=0 F S IEN=$O(^FSC("SUB","B",FROM,IEN)) Q:'IEN D
81 ..S PACK=+$P($G(^FSC("SUB",IEN,0)),U,2)
82 ..I 'PACK Q
83 ..S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
84 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(^FSC("SUB",IEN,0),U)_" - "_PACKNAME_U_$P(^(0),U)
85 Q
86 ;
87SUBPACK(PACK) ;
88 N FROM,IEN,LINE,NAME,NUM,PACKNAME K ^TMP("FSC TEMP",$J)
89 S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
90 S IEN=0 F S IEN=$O(^FSC("SUB","AC",PACK,IEN)) Q:IEN="" D
91 .S NAME=$P($G(^FSC("SUB",IEN,0)),U)
92 .I '$L(NAME) Q
93 .S ^TMP("FSC TEMP",$J,NAME,IEN)=IEN_U_NAME_" - "_PACKNAME_U_NAME
94 S NUM=0
95 S NAME="" F S NAME=$O(^TMP("FSC TEMP",$J,NAME)) Q:NAME="" D
96 .S IEN=0 F S IEN=$O(^TMP("FSC TEMP",$J,NAME,IEN)) Q:IEN<1 S LINE=^(IEN) D
97 ..S NUM=NUM+1
98 ..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
99 K ^TMP("FSC TEMP",$J)
100 Q
101 ;
102ISC ;
103 N FROM,IEN,NUM S NUM=0
104 S FROM="" F S FROM=$O(^FSC("ISC","B",FROM)) Q:FROM="" D
105 .S IEN=0 F S IEN=$O(^FSC("ISC","B",FROM,IEN)) Q:'IEN D
106 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("ISC",IEN,0))
107 Q
108 ;
109FUNC ;
110 N FROM,IEN,NUM,ZERO S NUM=0
111 S FROM="" F S FROM=$O(^FSC("FUNC","B",FROM)) Q:FROM="" D
112 .S IEN=0 F S IEN=$O(^FSC("FUNC","B",FROM,IEN)) Q:'IEN D
113 ..S ZERO=$G(^FSC("FUNC",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
114 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
115 Q
116 ;
117TASK ;
118 N FROM,IEN,NUM,ZERO S NUM=0
119 S FROM="" F S FROM=$O(^FSC("TASK","B",FROM)) Q:FROM="" D
120 .S IEN=0 F S IEN=$O(^FSC("TASK","B",FROM,IEN)) Q:'IEN D
121 ..S ZERO=$G(^FSC("TASK",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
122 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
123 Q
124 ;
125LTYPE ;
126 N FROM,IEN,NUM S NUM=0
127 S FROM="" F S FROM=$O(^FSC("LTYPE","B",FROM)) Q:FROM="" D
128 .S IEN=0 F S IEN=$O(^FSC("LTYPE","B",FROM,IEN)) Q:'IEN D
129 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("LTYPE",IEN,0))
130 Q
131 ;
132PACKGP ;
133 N FROM,IEN,NUM S NUM=0
134 S FROM="" F S FROM=$O(^FSC("PACKG","B",FROM)) Q:FROM="" D
135 .S IEN=0 F S IEN=$O(^FSC("PACKG","B",FROM,IEN)) Q:'IEN D
136 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PACKG",IEN,0))
137 Q
138 ;
139VISN ;
140 N FROM,IEN,NUM S NUM=0
141 S FROM="" F S FROM=$O(^FSC("VISN","B",FROM)) Q:FROM="" D
142 .S IEN=0 F S IEN=$O(^FSC("VISN","B",FROM,IEN)) Q:'IEN D
143 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("VISN",IEN,0))
144 Q
145 ;
146WEB(PACK) ;
147 N IEN,NUM S NUM=0
148 S IEN=0 F S IEN=$O(^FSCD("WEB","C",PACK,IEN)) Q:'IEN D
149 .S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSCD("WEB",IEN,1))
150 Q
151EPTYPE ;
152 N FROM,IEN,NUM S NUM=0
153 S FROM="" F S FROM=$O(^FSC("EPTYPE","B",FROM)) Q:FROM="" D
154 .S IEN=0 F S IEN=$O(^FSC("EPTYPE","B",FROM,IEN)) Q:'IEN D
155 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("EPTYPE",IEN,0))
156 Q
157 ;
158SYSTEM ;
159 N FROM,IEN,NUM S NUM=0
160 S FROM="" F S FROM=$O(^FSC("SYSTEM","B",FROM)) Q:FROM="" D
161 .S IEN=0 F S IEN=$O(^FSC("SYSTEM","B",FROM,IEN)) Q:'IEN D
162 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("SYSTEM",IEN,0))
163 Q
164 ;
165FIELD ;
166 N FROM,IEN,NUM S NUM=0
167 S FROM="" F S FROM=$O(^FSC("FLD","B",FROM)) Q:FROM="" D
168 .S IEN=0 F S IEN=$O(^FSC("FLD","B",FROM,IEN)) Q:'IEN D
169 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("FLD",IEN,0))
170 Q
171 ;
172UPACK ;
173 N CNT,LINE,NUM,PACK
174 S (CNT,NUM)=0 F S NUM=$O(^FSC("SPEC",DUZ,30,NUM)) Q:NUM<1 S PACK=+$G(^(NUM,0)) I PACK D
175 .S LINE=$G(^FSC("PACK",PACK,0))
176 .I '$L(LINE) Q
177 .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=PACK_U_LINE
178 Q
179 ;
180USORT ;
181 N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
182 S NUM=0 F S NUM=$O(^FSC("FORMAT","C",DUZ,NUM)) Q:NUM<1 S LINE=$G(^FSC("FORMAT",NUM,0)) I $P(LINE,U,2)="S" D
183 .S FIELD="",DESCEND=""
184 .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
185 ..I +LINE1<1 Q
186 ..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
187 ..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
188 .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
189 Q
190 ;
191UDISPLAY ;
192 N FIELD,LINE,LINE1,NUM,SUBNUM
193 S NUM=0 F S NUM=$O(^FSC("FORMAT","C",DUZ,NUM)) Q:NUM<1 S LINE=$G(^FSC("FORMAT",NUM,0)) I $P(LINE,U,2)="F" D
194 .S FIELD=""
195 .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
196 ..I +LINE1<1 Q
197 ..S FIELD=FIELD_$P(LINE1,U)_";"
198 .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
199 Q
200 ;
201SORT ;
202 N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
203 S NUM=0 F S NUM=$O(^FSC("FORMAT",NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) I $P(LINE,U,2)="S" D
204 .S FIELD="",DESCEND=""
205 .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
206 ..I +LINE1<1 Q
207 ..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
208 ..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
209 .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
210 Q
211 ;
212DISPLAY ;
213 N FIELD,LINE,LINE1,NUM,SUBNUM
214 S NUM=0 F S NUM=$O(^FSC("FORMAT",NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) I $P(LINE,U,2)="F" D
215 .S FIELD=""
216 .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
217 ..I +LINE1<1 Q
218 ..S FIELD=FIELD_$P(LINE1,U)_";"
219 .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
220 Q
221 ;
222CLISTS ;
223 N CNT,LIST,LISTNAME,NUM,ZERO
224 S CNT=0
225 S LISTNAME="" F S LISTNAME=$O(^FSC("LIST","B",LISTNAME)) Q:LISTNAME="" D
226 .S NUM=0 F S NUM=$O(^FSC("LIST","B",LISTNAME,NUM)) Q:NUM<1 D
227 ..S ZERO=$G(^FSC("LIST",NUM,0))
228 ..I $L(ZERO),'$P(ZERO,U,2) D
229 ...S CNT=CNT+1
230 ...S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=NUM_U_ZERO
231 Q
232 ;
233ULISTS ;
234 N CNT,LINE,LIST,LISTNAME,NUM,USER,ZERO K ^TMP("FSC MERGE",$J)
235 S USER=+$P(FILE,";",2)
236 I '$D(^VA(200,USER,0)) Q
237 S CNT=0
238 S NUM=0 F S NUM=$O(^FSC("LIST","C",USER,NUM)) Q:NUM<1 D
239 .S ZERO=$G(^FSC("LIST",NUM,0))
240 .Q:'$L(ZERO) Q:$P(ZERO,U,2)'=USER
241 .S ^TMP("FSC MERGE",$J,$P(ZERO,U),NUM)=NUM_U_ZERO
242 S CNT=0
243 S LISTNAME="" F S LISTNAME=$O(^TMP("FSC MERGE",$J,LISTNAME)) Q:LISTNAME="" D
244 .S NUM=0 F S NUM=$O(^TMP("FSC MERGE",$J,LISTNAME,NUM)) Q:NUM<1 S LINE=^(NUM) D
245 ..S CNT=CNT+1
246 ..S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
247 K ^TMP("FSC MERGE",$J)
248 Q
Note: See TracBrowser for help on using the repository browser.