source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCXPOST.m@ 1384

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

initial load of WorldVistAEHR
File size: 5.6 KB
RevLine 
[613]1FSCXPOST ;SLC/STAFF-NOIS Xrefs Client ;9/6/98 22:21
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;;
4ALL ; from FSCTASKA
5 D SITE,OFFICE,MOD,PACK,LTYPE,PACKG,TASK,SYSTEM,FIELD
6 Q
7 ;
8SITE ;
9 N ABBREV,CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
10 ;W !,"NOIS LOCATION"
11 K ^FSC("SITE","ACL")
12 S IEN=0 F S IEN=$O(^FSC("SITE",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
13 .K ^FSC("SITE",IEN,99)
14 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),ABBREV=$P(ZERO,U,3)
15 .D SETUP("^FSC(""SITE"",",IEN,NUM,NAME)
16 .I $L(ABBREV) S NUM=NUM+1 D SETUP("^FSC(""SITE"",",IEN,NUM,ABBREV_" - "_NAME)
17 .S CNT=0 F S CNT=$O(^FSC("SITE",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
18 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
19 ..D SETUP("^FSC(""SITE"",",IEN,NUM,VALUE)
20 .S ^FSC("SITE",IEN,99,0)="^7105.199^"_NUM_U_NUM
21 Q
22 ;
23OFFICE ;
24 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
25 ;W !,"NOIS OFFICE"
26 K ^FSC("ISC","ACL")
27 S IEN=0 F S IEN=$O(^FSC("ISC",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
28 .K ^FSC("ISC",IEN,99)
29 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
30 .D SETUP("^FSC(""ISC"",",IEN,NUM,NAME)
31 .S CNT=0 F S CNT=$O(^FSC("ISC",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
32 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
33 ..D SETUP("^FSC(""ISC"",",IEN,NUM,VALUE)
34 .S ^FSC("ISC",IEN,99,0)="^7105.399^"_NUM_U_NUM
35 Q
36 ;
37MOD ;
38 N CNT,IEN,NAME,NAMECONV,NAMESP,NUM,SYN,VALUE,ZERO
39 ;W !,"NOIS MODULE/VERSION"
40 K ^FSC("MOD","ACL")
41 S IEN=0 F S IEN=$O(^FSC("MOD",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
42 .K ^FSC("MOD",IEN,99)
43 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),NAMECONV=$P(ZERO,U,7),NAMESP=$P(ZERO,U,4)
44 .I $P(ZERO,U,3)=1 S NAME=$TR(NAME,"/"," ")
45 .I $P(ZERO,U,3)=2 S NAME=$TR(NAME,"/","+")
46 .I $P(ZERO,U,3)=3 S NAME=$TR(NAME,"/","-")
47 .D SETUP("^FSC(""MOD"",",IEN,NUM,NAME)
48 .I $L(NAMECONV) S NUM=NUM+1 D SETUP("^FSC(""MOD"",",IEN,NUM,NAMECONV_" - "_NAME)
49 .I $L(NAMESP) S NUM=NUM+1 D SETUP("^FSC(""MOD"",",IEN,NUM,NAMESP_" - "_NAME)
50 .S CNT=0 F S CNT=$O(^FSC("MOD",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
51 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
52 ..D SETUP("^FSC(""MOD"",",IEN,NUM,VALUE)
53 .S ^FSC("MOD",IEN,99,0)="^7105.499^"_NUM_U_NUM
54 Q
55 ;
56PACK ;
57 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
58 ;W !,"NOIS PACKAGE"
59 K ^FSC("PACK","ACL")
60 S IEN=0 F S IEN=$O(^FSC("PACK",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
61 .K ^FSC("PACK",IEN,99)
62 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
63 .D SETUP("^FSC(""PACK"",",IEN,NUM,NAME)
64 .S CNT=0 F S CNT=$O(^FSC("PACK",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
65 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
66 ..D SETUP("^FSC(""PACK"",",IEN,NUM,VALUE)
67 .S ^FSC("PACK",IEN,99,0)="^7105.599^"_NUM_U_NUM
68 Q
69 ;
70LTYPE ;
71 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
72 ;W !,"NOIS LOCATION TYPE"
73 K ^FSC("LTYPE","ACL")
74 S IEN=0 F S IEN=$O(^FSC("LTYPE",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
75 .K ^FSC("LTYPE",IEN,99)
76 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
77 .D SETUP("^FSC(""LTYPE"",",IEN,NUM,NAME)
78 .S CNT=0 F S CNT=$O(^FSC("LTYPE",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
79 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
80 ..D SETUP("^FSC(""LTYPE"",",IEN,NUM,VALUE)
81 .S ^FSC("LTYPE",IEN,99,0)="^7105.799^"_NUM_U_NUM
82 Q
83 ;
84PACKG ;
85 N CNT,IEN,NAME,NUM,SHNAME,SYN,VALUE,ZERO
86 ;W !,"NOIS PACKAGE GROUP"
87 K ^FSC("PACKG","ACL")
88 S IEN=0 F S IEN=$O(^FSC("PACKG",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
89 .K ^FSC("PACKG",IEN,99)
90 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U)),SHNAME=$P(ZERO,U,3)
91 .D SETUP("^FSC(""PACKG"",",IEN,NUM,NAME)
92 .I $L(SHNAME) S NUM=NUM+1 D SETUP("^FSC(""PACKG"",",IEN,NUM,SHNAME_" - "_NAME)
93 .S CNT=0 F S CNT=$O(^FSC("PACKG",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
94 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
95 ..D SETUP("^FSC(""PACKG"",",IEN,NUM,VALUE)
96 .S ^FSC("PACKG",IEN,99,0)="^7105.899^"_NUM_U_NUM
97 Q
98 ;
99TASK ;
100 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
101 ;W !,"NOIS TASK"
102 K ^FSC("TASK","ACL")
103 S IEN=0 F S IEN=$O(^FSC("TASK",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
104 .K ^FSC("TASK",IEN,99)
105 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
106 .D SETUP("^FSC(""TASK"",",IEN,NUM,NAME)
107 .S CNT=0 F S CNT=$O(^FSC("TASK",IEN,2,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
108 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
109 ..D SETUP("^FSC(""TASK"",",IEN,NUM,VALUE)
110 .S ^FSC("TASK",IEN,99,0)="^7106.399^"_NUM_U_NUM
111 Q
112 ;
113SYSTEM ;
114 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
115 ;W !,"NOIS SYSTEM"
116 K ^FSC("SYSTEM","ACL")
117 S IEN=0 F S IEN=$O(^FSC("SYSTEM",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
118 .K ^FSC("SYSTEM",IEN,99)
119 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
120 .D SETUP("^FSC(""SYSTEM"",",IEN,NUM,NAME)
121 .S CNT=0 F S CNT=$O(^FSC("SYSTEM",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
122 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
123 ..D SETUP("^FSC(""SYSTEM"",",IEN,NUM,VALUE)
124 .S ^FSC("SYSTEM",IEN,99,0)="^7106.799^"_NUM_U_NUM
125 Q
126 ;
127FIELD ;
128 N CNT,IEN,NAME,NUM,SYN,VALUE,ZERO
129 ;W !,"NOIS FIELD"
130 K ^FSC("FLD","ACL")
131 S IEN=0 F S IEN=$O(^FSC("FLD",IEN)) Q:IEN<1 S ZERO=^(IEN,0) D
132 .K ^FSC("FLD",IEN,99)
133 .S NUM=1,NAME=$$MIXCASE($P(ZERO,U))
134 .D SETUP("^FSC(""FLD"",",IEN,NUM,NAME)
135 .S CNT=0 F S CNT=$O(^FSC("FLD",IEN,1,CNT)) Q:CNT<1 S SYN=^(CNT,0) D
136 ..S NUM=NUM+1,VALUE=$$MIXCASE(SYN_" - "_NAME)
137 ..D SETUP("^FSC(""FLD"",",IEN,NUM,VALUE)
138 .S ^FSC("FLD",IEN,99,0)="^7107.299^"_NUM_U_NUM
139 Q
140 ;
141SETUP(FILE,IEN,NUM,VALUE) ;
142 N GBL
143 S GBL=FILE_IEN_",99,"_NUM_",0)"
144 S @GBL=VALUE
145 S GBL=FILE_IEN_",99,""B"","""_VALUE_""","_NUM_")"
146 S @GBL=""
147 S GBL=FILE_"""ACL"","""_$$UP^XLFSTR(VALUE)_""","_IEN_","_NUM_")"
148 S @GBL=""
149 ;W "."
150 Q
151MIXCASE(TEXT) ; $$(text) -> mixed case format
152 N CHAR
153 S TEXT=$$LOW^XLFSTR(TEXT)
154 S $E(TEXT)=$$UP^XLFSTR($E(TEXT))
155 F CHAR=1:1:$L(TEXT) D
156 .I " ,-'/(&"[$E(TEXT,CHAR) S $E(TEXT,CHAR+1)=$$UP^XLFSTR($E(TEXT,CHAR+1))
157 Q TEXT
158 ;
159PRI ; populate primary calls with themselves
160 N CALL,CNT,DA,DIE,DR,X,Y
161 S CNT=0,DIE="^FSCD(""CALL"","
162 S CALL=0 F S CALL=$O(^FSCD("CALL",CALL)) Q:CALL<1 I $D(^(CALL,120)) D
163 .S DA=CALL
164 .S DR="101///`"_DA
165 .D ^DIE
166 .K ^FSCD("CALL",CALL,103)
167 .S CNT=CNT+1 I CNT#100=0 W "."
168 Q
Note: See TracBrowser for help on using the repository browser.