source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDI1000B.m@ 1246

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

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1HDI1000B ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE (CONT);2/23/2005
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3 ;
4SERVERS() ;Fix server options (they need resource devices)
5 ; Input: None
6 ;Output: 0 = Stop post-install (error)
7 ; 1 = Continue with post-install
8 N SRVR,RSRC,HDIMSG
9 ;Fix VUID Server option
10 S SRVR="HDIS-FACILITY-DATA-SERVER"
11 S RSRC="HDIS VUID RESOURCE DEVICE"
12 S HDIMSG(1)=" "
13 S HDIMSG(2)="Making "_RSRC_" the resource device"
14 S HDIMSG(3)="for "_SRVR
15 S HDIMSG(4)=" "
16 D MES^XPDUTL(.HDIMSG) K HDIMSG
17 I '$$FIXSRVR(SRVR,RSRC) Q 0
18 ;Fix Status Server option
19 S SRVR="HDIS-STATUS-UPDATE-SERVER"
20 S RSRC="HDIS STATUS RESOURCE DEVICE"
21 S HDIMSG(1)=" "
22 S HDIMSG(2)="Making "_RSRC_" the resource device"
23 S HDIMSG(3)="for "_SRVR
24 S HDIMSG(4)=" "
25 D MES^XPDUTL(.HDIMSG) K HDIMSG
26 I '$$FIXSRVR(SRVR,RSRC) Q 0
27 ;Done
28 Q 1
29 ;
30FIXSRVR(SRVR,RSRC) ;Fix server option
31 ; Input: SRVR - Name of server option
32 ; RSRC - Name of resource device
33 ;Output: 1 = Success 0 = Error/bad input
34 ; Notes: Call assumes that all input have values
35 N HDIMSG,PTRSRVR,PTRRSRC
36 S SRVR=$G(SRVR)
37 S RSRC=$G(RSRC)
38 ;Find option
39 S PTRSRVR=$$PTROPT(SRVR)
40 I 'PTRSRVR D Q 0
41 .I SRVR="" S SRVR="<null>"
42 .S HDIMSG(1)="**"
43 .S HDIMSG(2)="** Unable to find "_SRVR_" in the OPTION file (#19)"
44 .S HDIMSG(3)="** Post-installation will be halted"
45 .S HDIMSG(4)="**"
46 .D MES^XPDUTL(.HDIMSG) K HDIMSG
47 ;Create/find resource device
48 S PTRRSRC=$$CR8RD(RSRC,1)
49 I 'PTRRSRC D Q 0
50 .I RSRC="" S RSRC="<null>"
51 .S HDIMSG(1)="**"
52 .S HDIMSG(2)="** Unable to find/create "_RSRC_" in the DEVICE file (#3.5)"
53 .S HDIMSG(3)="** Post-installation will be halted"
54 .S HDIMSG(4)="**"
55 .D MES^XPDUTL(.HDIMSG) K HDIMSG
56 ;Attach resource device to server
57 I '$$RD4OPT(PTRRSRC,PTRSRVR) D Q 0
58 .S HDIMSG(1)="**"
59 .S HDIMSG(2)="** Unable to add "_RSRC_" as the resource"
60 .S HDIMSG(3)="** device for server option "_SRVR
61 .S HDIMSG(4)="** Post-installation will be halted"
62 .S HDIMSG(5)="**"
63 .D MES^XPDUTL(.HDIMSG) K HDIMSG
64 Q 1
65 ;
66CR8RD(NAME,SLOTS) ;Create resource device
67 ; Input: NAME - Name of resource device to create
68 ; SLOTS - Number of resource slots (defaults to 1)
69 ;Output: Pointer to resource device (DEVICE file)
70 ; 0 will be returned on error/bad input
71 ; Notes: If the device NAME already exists, the pointer to that device
72 ; will be returned. The definition of the device will not be
73 ; checked and/or modified.
74 S NAME=$G(NAME)
75 I NAME="" Q 0
76 S SLOTS=+$G(SLOTS)
77 I SLOTS<1 S SLOTS=1
78 N PTRDVC,HDIMSG
79 ;Device alread exist - return pointer to it
80 S PTRDVC=$$FIND1^DIC(3.5,"","X",NAME,"B","","HDIMSG")
81 I PTRDVC Q PTRDVC
82 ;Create resource device
83 S PTRDVC=+$$RES^XUDHSET(NAME,NAME,SLOTS)
84 I PTRDVC<1 S PTRDVC=0
85 Q PTRDVC
86 ;
87PTROPT(NAME) ;Get pointer to option
88 ; Input: NAME - Option name
89 ;Output: Pointer to OPTION file (#19)
90 ; Notes: 0 returned when option not found
91 N PTROPT,HDIMSG
92 S PTROPT=$$FIND1^DIC(19,"","X",$G(NAME),"B","","HDIMSG")
93 I $D(HDIMSG) Q 0
94 Q PTROPT
95 ;
96RD4OPT(PTRDVC,PTROPT) ;Attach resource device to option
97 ; Input: PTRDVC - Pointer to DEVICE file (#3.5)
98 ; PTROPT - Pointer to OPTION file (#19)
99 ;Output: 1 = Success 0 = Error/Bad input
100 ; Notes: Call assumes all input exists and is valid
101 N HDIFDA,HDIMSG
102 S PTRDVC=+$G(PTRDVC)
103 I 'PTRDVC Q 0
104 S PTROPT=+$G(PTROPT)
105 I 'PTROPT Q 0
106 S HDIFDA(19,PTROPT_",",227)=PTRDVC
107 D FILE^DIE("","HDIFDA","HDIMSG")
108 I $D(HDIMSG) Q 0
109 Q 1
110 ;
111ATTBUL() ;Attach HDIS Mail Groups to HDIS Bulletins
112 N HDISBIEN,HDISBNM,HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISTXT
113 K HDIMSG
114 D BMES^XPDUTL("Attaching HDIS Mail Groups to HDIS Bulletins")
115 F HDISLNE=1:1 S HDISTXT=$P($T(BULGRP+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF)) D
116 . S HDISBNM=$P(HDISTXT,"^",1)
117 . S HDISBIEN=$$FIND1^DIC(3.6,"","X",HDISBNM,"","","")
118 . S HDISGNM=$P(HDISTXT,"^",2)
119 . S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
120 . ;If Bulletin or Mail Group not found, error
121 . I HDISBIEN'>0!(HDISGIEN'>0) D
122 . . S HDIMSG(1)="**"
123 . . S HDIMSG(2)="** Bulletin "_HDISBNM_" or Mail Group "_HDISGNM_" not found"
124 . . D MES^XPDUTL(.HDIMSG) K HDIMSG
125 . . S HDISERRF=1
126 . ELSE D
127 . . ;Attach Mail Group to Bulletin
128 . . N HDISFDA,HDISIEN,HDISMSG
129 . . S HDISFDA(3.62,"?+2,"_HDISBIEN_",",.01)=HDISGIEN
130 . . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
131 . . ;Check for error
132 . . I $D(HDISMSG("DIERR")) D
133 . . . S HDIMSG(1)="**"
134 . . . S HDIMSG(2)="** Unable to attach "_HDISGNM_" to "_HDISBNM
135 . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
136 . . . S HDISERRF=1
137 . . ELSE D
138 . . . S HDIMSG(1)=" "
139 . . . S HDIMSG(2)=".."_HDISGNM_" Mail Group"_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISBNM_" Bulletin"
140 . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
141 ;Check for error
142 I $G(HDISERRF) D
143 . S HDIMSG(1)="** Post-installation will be halted"
144 . S HDIMSG(2)="**"
145 . D MES^XPDUTL(.HDIMSG) K HDIMSG
146 Q +$S($G(HDISERRF):0,1:1)
147 ;
148BULGRP ;Bulletin Name^Mail Group Name
149 ;;HDIS ERRORS^HDIS ERRORS
150 ;;HDIS NOTIFY ERT^HDIS ERT NOTIFICATION
151 ;;HDIS NOTIFY HDR^HDIS HDR NOTIFICATION
152 ;;HDIS XML MSG PROCESS ERROR^HDIS ERRORS
153 ;;END
154 ;
155ATTREM() ;Attach HDIS Remote Members to HDIS Mail Groups
156 N HDISERRF,HDISFDA,HDISGIEN,HDISGNM,HDISLNE,HDISMSG,HDISRNM,HDISTXT
157 K HDIMSG
158 D BMES^XPDUTL("Attaching HDIS Remote Members to HDIS Mail Groups")
159 F HDISLNE=1:1 S HDISTXT=$P($T(REMMEM+HDISLNE),";;",2) Q:HDISTXT="END"!($G(HDISERRF)) D
160 . S HDISGNM=$P(HDISTXT,"^",1)
161 . S HDISGIEN=$$FIND1^DIC(3.8,"","X",HDISGNM,"","","")
162 . S HDISRNM=$P(HDISTXT,"^",2)
163 . ;If Mail Group not found, error
164 . I HDISGIEN'>0 D
165 . . S HDIMSG(1)="**"
166 . . S HDIMSG(2)="** Mail Group "_HDISGNM_" not found"
167 . . D MES^XPDUTL(.HDIMSG) K HDIMSG
168 . . S HDISERRF=1
169 . ELSE D
170 . . ;Attach Remote Member to Mail Group
171 . . N HDISFDA,HDISIEN,HDISMSG
172 . . S HDISFDA(3.812,"?+2,"_HDISGIEN_",",.01)=HDISRNM
173 . . D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
174 . . ;Check for error
175 . . I $D(HDISMSG("DIERR")) D
176 . . . S HDIMSG(1)="**"
177 . . . S HDIMSG(2)="** Unable to attach "_HDISRNM_" to "_HDISGNM
178 . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
179 . . . S HDISERRF=1
180 . . ELSE D
181 . . . S HDIMSG(1)=" "
182 . . . S HDIMSG(2)=".."_HDISRNM_$S($G(HDISIEN(2,0))="?":" already",1:"")_" attached to "_HDISGNM
183 . . . D MES^XPDUTL(.HDIMSG) K HDIMSG
184 ;Check for error
185 I $G(HDISERRF) D
186 . S HDIMSG(1)="** Post-installation will be halted"
187 . S HDIMSG(2)="**"
188 . D MES^XPDUTL(.HDIMSG) K HDIMSG
189 Q +$S($G(HDISERRF):0,1:1)
190 ;
191REMMEM ;Mail Group Name^Remote Member
192 ;;HDIS ERRORS^G.HDIS ERRORS@FORUM.VA.GOV
193 ;;HDIS ERT NOTIFICATION^G.HDIS ERRORS@FORUM.VA.GOV
194 ;;HDIS ERT NOTIFICATION^G.HDIS ERT NOTIFICATION@FORUM.VA.GOV
195 ;;HDIS HDR NOTIFICATION^G.HDIS HDR NOTIFICATION@FORUM.VA.GOV
196 ;;END
Note: See TracBrowser for help on using the repository browser.