source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDI1000A.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.5 KB
RevLine 
[613]1HDI1000A ;BPFO/JRP - HDI v1.0 POST-INSTALL ROUTINE;2/17/2005
2 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
3 ;
4POST ;Main entry point for post-install routine
5 ; Input: None
6 ; All variables set by Kernel for KIDS post-installs
7 ;Output: None
8 N HDIMSG
9 S HDIMSG(1)=" "
10 S HDIMSG(2)="~~~~~~~~~~~~~~~~~~~~"
11 S HDIMSG(3)="Post-Installation (POST^HDI1000A) will now be run"
12 S HDIMSG(4)=" "
13 D MES^XPDUTL(.HDIMSG) K HDIMSG
14 I '$$SERVERS^HDI1000B() D PSTHALT Q
15 I '$$ATTBUL^HDI1000B() D PSTHALT Q
16 I '$$ATTREM^HDI1000B() D PSTHALT Q
17 I '$$SYSPAR() D PSTHALT Q
18 I '$$VUID() D PSTHALT Q
19 S HDIMSG(1)=" "
20 S HDIMSG(2)="Post-Installation ran to completion"
21 S HDIMSG(3)="~~~~~~~~~~~~~~~~~~~~"
22 S HDIMSG(4)=" "
23 D MES^XPDUTL(.HDIMSG) K HDIMSG
24 Q
25 ;
26PSTHALT ;Print post-install halted text
27 N HDIMSG
28 S HDIMSG(1)=" "
29 S HDIMSG(2)="*****"
30 S HDIMSG(3)="***** Post-installation has been halted"
31 S HDIMSG(4)="***** Please contact Enterprise VistA Support"
32 S HDIMSG(5)="*****"
33 S HDIMSG(6)=" "
34 D MES^XPDUTL(.HDIMSG)
35 Q
36 ;
37SYSPAR() ;Initialize HDIS System and HDIS Parameter files
38 ; Input: None
39 ;Output: 0 = Stop post-install (error)
40 ; 1 = Continue with post-install
41 N FACNUM,DOMAIN,SYSTYPE,X,SYSPTR,HDIMSG,PRAMPTR
42 ;Determine system information
43 S FACNUM=$$FACNUM^HDISVF01()
44 S DOMAIN=$G(^XMB("NETNAME"))
45 S SYSTYPE=$$PROD^XUPROD()
46 S HDIMSG(1)=" "
47 S HDIMSG(2)="The following information concerning this system has been"
48 S HDIMSG(3)="determined and will be used to initialize the HDIS SYSTEM"
49 S HDIMSG(4)="(#7118.21) and HDIS PARAMETER (#7118.29) files"
50 S HDIMSG(5)=" "
51 S HDIMSG(6)=" Facility Number: "_FACNUM
52 S HDIMSG(7)=" MailMan Domain: "_DOMAIN
53 S HDIMSG(8)=" System Type: "_$S(SYSTYPE:"Production",1:"Test")
54 S HDIMSG(9)=" "
55 D MES^XPDUTL(.HDIMSG) K HDIMSG
56 ;Create entry in HDIS System file
57 D BMES^XPDUTL("Creating entry in HDIS SYSTEM file")
58 I '$$FINDSYS^HDISVF07(DOMAIN,FACNUM,SYSTYPE,1,.SYSPTR) D Q 0
59 .S HDIMSG(1)="**"
60 .S HDIMSG(2)="** Unable to create entry"
61 .S HDIMSG(3)="** Post-installation will be halted"
62 .S HDIMSG(4)="**"
63 .D MES^XPDUTL(.HDIMSG) K HDIMSG
64 D MES^XPDUTL("Entry number "_SYSPTR_" created")
65 ;Create entry in HDIS Parameter file
66 D BMES^XPDUTL("Creating entry in HDIS PARAMETER file")
67 S PRAMPTR=$$PARAMINI^HDISVF10(SYSPTR)
68 I 'PRAMPTR D Q 0
69 .S HDIMSG(1)="**"
70 .S HDIMSG(2)="** Unable to create entry"
71 .S HDIMSG(3)="** Post-installation will be halted"
72 .S HDIMSG(4)="**"
73 .D MES^XPDUTL(.HDIMSG) K HDIMSG
74 D MES^XPDUTL("Entry number "_PRAMPTR_" created")
75 ;Done if this is not FORUM
76 I DOMAIN'="FORUM.VA.GOV" Q 1
77 ;This is FORUM - make it a server
78 D BMES^XPDUTL("Making FORUM a server")
79 D SETTYPE^HDISVF02(2,SYSPTR)
80 I (+$$GETTYPE^HDISVF02(SYSPTR))'=2 D
81 .S HDIMSG(1)="**"
82 .S HDIMSG(2)="** Unable to change system type to SERVER"
83 .S HDIMSG(3)="**"
84 .D MES^XPDUTL(.HDIMSG) K HDIMSG
85 ;Set Last Non-Standard VUID field
86 I '$$GETNSVL^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,51,PRAMPTR_",",4536403,1)
87 I '$$GETNSVL^HDISVF03(SYSPTR) D
88 .S HDIMSG(1)="**"
89 .S HDIMSG(2)="** Unable to set LAST NON-STANDARD VUID field to 4536403"
90 .S HDIMSG(3)="**"
91 .D MES^XPDUTL(.HDIMSG) K HDIMSG
92 ;Set Ending Non-Standard VUID field
93 I '$$GETNSVE^HDISVF03(SYSPTR) S X=$$SET^HDISVF02(7118.29,52,PRAMPTR_",",4636403,1)
94 I '$$GETNSVE^HDISVF03(SYSPTR) D
95 .S HDIMSG(1)="**"
96 .S HDIMSG(2)="** Unable to set ENDING NON-STANDARD VUID field to 4636403"
97 .S HDIMSG(3)="**"
98 .D MES^XPDUTL(.HDIMSG) K HDIMSG
99 ;Done
100 Q 1
101 ;
102VUID() ;Instantiate VUIDs for set of code fields in Vitals domain
103 ; Input: None
104 ;Output: 0 = Stop post-install (error)
105 ; 1 = Continue with post-install
106 N HDIMSG
107 S HDIMSG(1)=" "
108 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with Vitals data"
109 S HDIMSG(3)=" "
110 D MES^XPDUTL(.HDIMSG) K HDIMSG
111 I '$$VUIDL("VITALS","HDI1000C") Q 0
112 S HDIMSG(1)=" "
113 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Allergy data"
114 S HDIMSG(3)=" "
115 D MES^XPDUTL(.HDIMSG) K HDIMSG
116 I '$$VUIDL("ALLERGY","HDI1000C") Q 0
117 S HDIMSG(1)=" "
118 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (8985.1) with Lab & Pharmacy data"
119 S HDIMSG(3)=" "
120 D MES^XPDUTL(.HDIMSG) K HDIMSG
121 I '$$VUIDL("LABPHAR","HDI1000D") Q 0
122 I '$$VUIDL("LABPHAR","HDI1000E") Q 0
123 I '$$VUIDL("LABPHAR","HDI1000F") Q 0
124 I '$$VUIDL("LABPHAR","HDI1000G") Q 0
125 Q 1
126 ;
127VUIDL(TAG,ROUTINE) ;Instantiate VUIDs for set of code fields
128 ; Input: TAG - Line tag under which VUID data has been placed
129 ; ROUTINE - Routine line tag is in
130 ; Leave blank if in this routine
131 ;Output: 0 = Stop post-install (error)
132 ; 1 = Continue with post-install
133 ; Notes: Data lines must be in the format
134 ; File~Field~Code~VUID~Status~EffectiveDateTime
135 ; (Status and EffectiveDateTime must be in internal format)
136 ; (Default value for Status is 0 - Inactive)
137 ; (Default value for EffectiveDateTime is NOW)
138 ; : Call assumes that all input (TAG & ROUTINE) is valid
139 ; : Call assumes that data lines are valid
140 ; (i.e. no missing/bad data)
141 N OFFSET,DATA,FILE,FIELD,IREF,VUID,STAT,STDT,DONE,RESULT,HDIMSG
142 S ROUTINE=$G(ROUTINE)
143 S RESULT=1
144 S DONE=0
145 F OFFSET=1:1 D Q:DONE
146 .S DATA=$S(ROUTINE="":$T(@TAG+OFFSET),1:$T(@TAG+OFFSET^@ROUTINE))
147 .S DATA=$P(DATA,";;",2)
148 .I DATA="" S DONE=1 Q
149 .S FILE=$P(DATA,"~",1)
150 .S FIELD=$P(DATA,"~",2)
151 .S IREF=$P(DATA,"~",3)
152 .S VUID=$P(DATA,"~",4)
153 .S STAT=$P(DATA,"~",5)
154 .I STAT="" S STAT=0
155 .S STDT=$P(DATA,"~",6)
156 .I STDT="" S STDT=$$NOW^XLFDT()
157 .I '$$STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) D
158 ..S HDIMSG(1)="**"
159 ..S HDIMSG(2)="** Unable to store VUID and/or status information for file"
160 ..S HDIMSG(3)="** "_FILE_", field "_FIELD_", and internal value "_IREF
161 ..S HDIMSG(4)="**"
162 ..D MES^XPDUTL(.HDIMSG) K HDIMSG
163 ..S RESULT=0
164 Q RESULT
165 ;
166STOREIT(FILE,FIELD,IREF,VUID,STAT,STDT) ;Store VUID info
167 ; Input : FILE - File number
168 ; FIELD - Field number
169 ; IREF - Internal reference
170 ; VUID - VUID
171 ; STAT - Status
172 ; 0 = Inacive (default) 1 = Active
173 ; STDT - Status Date/Time (FileMan)
174 ; (Defaults to NOW)
175 ;Output : 1 = Success
176 ; 0 = Failure
177 ; Notes : Existance/validity of input assumed (internal call)
178 ; : Call will automatically inactivate terms when appropriate
179 ;
180 N TMP,MASTER
181 S STAT=+$G(STAT)
182 S STDT=+$G(STDT)
183 I 'STDT S STDT=$$NOW^XLFDT()
184 ;Store VUID (also sets master entry flag, if appropriate)
185 I '$$SETVUID^XTID(FILE,FIELD,IREF,VUID) Q 0
186 ;Inactivate non-master entries
187 I '$$GETMASTR^XTID(FILE,FIELD,IREF) D
188 .S STAT=0
189 .S STDT=$$NOW^XLFDT()
190 ;Store status
191 Q $$SETSTAT^XTID(FILE,FIELD,IREF,STAT,STDT)
Note: See TracBrowser for help on using the repository browser.