source: FOIAVistA/trunk/r/NOIS-FSC/FSCRPCLL.m@ 1765

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1FSCRPCLL ;SLC/STAFF-NOIS RPC List Long ;4/4/98 17:56
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
5 N DIR,FILE,FROM,LINE
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 S FROM=$$FROM(FROM,FILE)
9 I $E(FROM,$L(FROM)-1,$L(FROM))="`~" S $E(FROM,$L(FROM)-1,$L(FROM))="@~"
10 I FILE="LOC" D LOC(FROM,DIR) Q
11 I FILE="ACLLOC" D ACLLOC(FROM,DIR) Q
12 I FILE="MOD" D MOD(FROM,DIR) Q
13 I FILE="ACLMOD" D ACLMOD(FROM,DIR) Q
14 I FILE="PACK" D PACK(FROM,DIR) Q
15 I FILE="ACLPACK" D ACLPACK(FROM,DIR) Q
16 I FILE="MAILGP" D MAILGP(FROM,DIR) Q
17 I FILE="PATCH" D PATCH(FROM,DIR) Q
18 I FILE="USER" D USER(FROM,DIR) Q
19 I FILE="LIST" D LIST(FROM,DIR) Q
20 I FILE="CALL" D CALL(FROM,DIR) Q
21 Q
22 ;
23LOC(FROM,DIR) ;
24 N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
25 F Q:NUM>CNT S FROM=$O(^FSC("SITE","B",FROM),DIR) Q:FROM="" D
26 .S IEN=0 F S IEN=$O(^FSC("SITE","B",FROM,IEN)) Q:'IEN D
27 ..S ZERO=$G(^FSC("SITE",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
28 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
29 Q
30 ;
31ACLLOC(FROM,DIR) ;
32 N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
33 S FROM=$$UP^XLFSTR(FROM)
34 F Q:NUM>CNT S FROM=$O(^FSC("SITE","ACL",FROM),DIR) Q:FROM="" D
35 .S IEN=0 F S IEN=$O(^FSC("SITE","ACL",FROM,IEN)) Q:'IEN D
36 ..S ZERO=$G(^FSC("SITE",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
37 ..S IEN1=0 F S IEN1=$O(^FSC("SITE","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
38 ...S TEXT=$G(^FSC("SITE",IEN,99,IEN1,0)) Q:'$L(TEXT)
39 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
40 Q
41 ;
42ACLMOD(FROM,DIR) ;
43 N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
44 S FROM=$$UP^XLFSTR(FROM)
45 F Q:NUM>CNT S FROM=$O(^FSC("MOD","ACL",FROM),DIR) Q:FROM="" D
46 .S IEN=0 F S IEN=$O(^FSC("MOD","ACL",FROM,IEN)) Q:'IEN D
47 ..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
48 ..S IEN1=0 F S IEN1=$O(^FSC("MOD","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
49 ...S TEXT=$G(^FSC("MOD",IEN,99,IEN1,0)) Q:'$L(TEXT)
50 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
51 Q
52 ;
53MOD(FROM,DIR) ;
54 N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
55 F Q:NUM>CNT S FROM=$O(^FSC("MOD","B",FROM),DIR) Q:FROM="" D
56 .S IEN=0 F S IEN=$O(^FSC("MOD","B",FROM,IEN)) Q:'IEN D
57 ..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
58 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
59 Q
60 ;
61PACK(FROM,DIR) ;
62 N IEN,CNT,NUM S CNT=44,NUM=0
63 F Q:NUM>CNT S FROM=$O(^FSC("PACK","B",FROM),DIR) Q:FROM="" D
64 .S IEN=0 F S IEN=$O(^FSC("PACK","B",FROM,IEN)) Q:'IEN D
65 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PACK",IEN,0))
66 Q
67 ;
68ACLPACK(FROM,DIR) ;
69 N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
70 S FROM=$$UP^XLFSTR(FROM)
71 F Q:NUM>CNT S FROM=$O(^FSC("MOD","ACL",FROM),DIR) Q:FROM="" D
72 .S IEN=0 F S IEN=$O(^FSC("MOD","ACL",FROM,IEN)) Q:'IEN D
73 ..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
74 ..S IEN1=0 F S IEN1=$O(^FSC("MOD","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
75 ...S TEXT=$G(^FSC("MOD",IEN,99,IEN1,0)) Q:'$L(TEXT)
76 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
77 Q
78 ;
79MAILGP(FROM,DIR) ;
80 N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
81 F Q:NUM>CNT S FROM=$O(^XMB(3.8,"B",FROM),DIR) Q:FROM="" D
82 .S IEN=0 F S IEN=$O(^XMB(3.8,"B",FROM,IEN)) Q:'IEN D
83 ..S ZERO=$G(^XMB(3.8,IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)="PR" Q:$O(^XMB(3.8,IEN,4,0))
84 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
85 Q
86 ;
87PATCH(FROM,DIR) ;
88 N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
89 F Q:NUM>CNT S FROM=$O(^A1AE(11005,"B",FROM),DIR) Q:FROM="" D
90 .S IEN=0 F S IEN=$O(^A1AE(11005,"B",FROM,IEN)) Q:'IEN D
91 ..S ZERO=$G(^A1AE(11005,IEN,0)) Q:'$L(ZERO)
92 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(ZERO,U)_" Seq# "_$P(ZERO,U,6)_" "_$P(ZERO,U,5)
93 Q
94 ;
95USER(FROM,DIR) ;
96 N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
97 F Q:NUM>CNT S FROM=$O(^VA(200,"B",FROM),DIR) Q:FROM="" D
98 .S IEN=0 F S IEN=$O(^VA(200,"B",FROM,IEN)) Q:'IEN D
99 ..S ZERO=$G(^VA(200,IEN,0)) Q:'$L(ZERO) Q:ZERO I $P(ZERO,U,11),$P(ZERO,U,11)<DT Q
100 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(ZERO,U)
101 Q
102 ;
103LIST(FROM,DIR) ;
104 N IEN,CNT,NUM S CNT=44,NUM=0
105 F Q:NUM>CNT S FROM=$O(^FSC("LIST","B",FROM),DIR) Q:FROM="" D
106 .S IEN=0 F S IEN=$O(^FSC("LIST","B",FROM,IEN)) Q:'IEN D
107 ..Q:$P($G(^FSC("LIST",IEN,0)),U,99)="INACTIVE" ;*** fix
108 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("LIST",IEN,0))
109 Q
110 ;
111CALL(FROM,DIR) ;
112 N IEN,CNT,NUM S CNT=44,NUM=0
113 F Q:NUM>CNT S FROM=$O(^FSCD("CALL","B",FROM),DIR) Q:FROM="" D
114 .S IEN=0 F S IEN=$O(^FSCD("CALL","B",FROM,IEN)) Q:'IEN D
115 ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSCD("CALL",IEN,0))
116 Q
117 ;
118FROM(FROM,FILE) ; $$(from) -> exteral value for `ien lookups
119 N EXACT
120 I $E(FROM)="`" D Q FROM
121 .I $E(FROM,$L(FROM)-1)="/" S EXACT=+$E(FROM,2,245)*10
122 .E S EXACT=1+$E(FROM,2,245)
123 .I FILE="USER" S FROM=$P($G(^VA(200,EXACT,0)),U)
124 .I FILE="MOD" S FROM=$P($G(^FSC("MOD",EXACT,0)),U)
125 .I FILE="ACLMOD" S FROM=$G(^FSC("MOD",EXACT,99,+$O(^FSC("MOD",EXACT,99,0)),0))
126 .I FILE="LOC" S FROM=$P($G(^FSC("SITE",EXACT,0)),U)
127 .I FILE="ACLLOC" S FROM=$G(^FSC("SITE",EXACT,99,+$O(^FSC("SITE",EXACT,99,0)),0))
128 .I FILE="MAILGP" S FROM=$P($G(^XMB(3.8,EXACT,0)),U)
129 .I FILE="PATCH" S FROM=$P($G(^A1AE(11005,EXACT,0)),U)
130 .I FILE="PACK" S FROM=$P($G(^FSC("PACK",EXACT,0)),U)
131 .I FILE="ACLPACK" S FROM=$G(^FSC("PACK",EXACT,99,+$O(^FSC("PACK",EXACT,99,0)),0))
132 .I FILE="LIST" S FROM=$P($G(^FSC("LIST",EXACT,0)),U)
133 .S FROM=$E(FROM,1,$L(FROM)-1)_$C($A($E(FROM,$L(FROM)))-1)_"~"
134 Q FROM
Note: See TracBrowser for help on using the repository browser.