source: FOIAVistA/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVF09.m@ 969

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

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1HDISVF09 ;ALB/RMO,ALB/GRR - 7115.1 File Utilities/API Cont.; 2/1/06@09:56:00
2 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
3 ;
4 ;---- Begin HDIS Domain file (#7115.1) API(s) ----
5 ;
6FINDDOM(HDISDOM,HDISDFFS,HDISADDF,HDISDIEN,HDISERRM) ;Find or Add a New Domain Entry
7 ; Input -- HDISDOM Domain Name
8 ; HDISDFFS Domain File/Field Array (Optional)
9 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
10 ; Example: HDISDFFS(100.1)=""
11 ; HDISADDF Add a New Entry Flag (Optional- Default 0)
12 ; 1=Yes and 0=No
13 ; Output -- 1=Successful and 0=Failure
14 ; If Successful:
15 ; HDISDIEN HDIS Domain file IEN
16 ; If Failure:
17 ; HDISERRM Error Message (Optional)
18 N HDISOKF
19 ;Initialize output
20 S (HDISDIEN,HDISERRM)=""
21 ;Check for missing variable, exit if not defined
22 I $G(HDISDOM)="" D G FINDDOMQ
23 . S HDISERRM="Unable to Find or Add Domain. Required Variable Missing."
24 ;Check for existing Domain, return entry and exit if it exists
25 I $D(^HDIS(7115.1,"B",HDISDOM)) D G FINDDOMQ:$G(HDISDIEN)
26 . S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
27 . S HDISOKF=1
28 ;If flag set, Add a New Domain Entry
29 I $G(HDISADDF) S HDISOKF=$$ADDDOM(HDISDOM,.HDISDFFS,.HDISDIEN,.HDISERRM)
30FINDDOMQ Q +$G(HDISOKF)
31 ;
32ADDDOM(HDISDOM,HDISDFFS,HDISDIEN,HDISERRM) ;Add a New Domain Entry
33 ; Input -- HDISDOM Domain Name
34 ; HDISDFFS Domain File/Field Array (Optional)
35 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
36 ; Example: HDISDFFS(100.1)=""
37 ; Output -- 1=Successful and 0=Failure
38 ; If Successful:
39 ; HDISDIEN HDIS Domain file IEN
40 ; If Failure:
41 ; HDISERRM Error Message (Optional)
42 N HDISFDA,HDISIEN,HDISMSG,HDISOKF
43 ;Initialize output
44 S (HDISDIEN,HDISERRM)=""
45 ;Check for missing variable, exit if not defined
46 I $G(HDISDOM)="" D G ADDDOMQ
47 . S HDISERRM="Unable to Add Domain. Required Variable Missing."
48 ;Check for existing Domain, return error and exit if it exists
49 I $D(^HDIS(7115.1,"B",HDISDOM)) D G ADDDOMQ
50 . S HDISERRM="Domain already exists."
51 ;Set array for Domain Name
52 S HDISFDA(7115.1,"+1,",.01)=$G(HDISDOM)
53 D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
54 ;Check for error
55 I $D(HDISMSG("DIERR")) D
56 . S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
57 ELSE D
58 . S HDISDIEN=+$G(HDISIEN(1))
59 . S HDISOKF=1
60 D CLEAN^DILF
61 ;If Domain File/Field Array is passed, Add Domain File/Fields
62 I $G(HDISDIEN)>0,$D(HDISDFFS) S HDISOKF=$$ADDDFFS(HDISDIEN,.HDISDFFS,.HDISERRM)
63ADDDOMQ Q +$G(HDISOKF)
64 ;
65ADDDFFS(HDISDIEN,HDISDFFS,HDISERRM) ;Add Domain File/Fields
66 ; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
67 ; HDISDFFS Domain File/Field Array
68 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
69 ; Example: HDISDFFS(100.1)=""
70 ; Output -- 1=Successful and 0=Failure
71 ; If Failure:
72 ; HDISERRM Error Message (Optional)
73 N HDISCNT,HDISFARY,HDISFDA,HDISFFNM,HDISFIEN,HDISFILN,HDISFLDN,HDISIEN,HDISMSG,HDISOKF
74 ;Initialize output
75 S HDISERRM=""
76 ;Check for missing variables, exit if not defined
77 I $G(HDISDIEN)'>0!('$D(HDISDFFS)) D G ADDDFFSQ
78 . S HDISERRM="Unable to Add Domain File/Fields. Required Variable Missing."
79 ;Add a new File/Field Entry
80 S HDISFILN=0
81 F S HDISFILN=$O(HDISDFFS(HDISFILN)) Q:'HDISFILN D G ADDDFFSQ:HDISERRM'=""
82 . ;Set Field Number to default of .01, if not defined
83 . S HDISFLDN=$S($G(HDISDFFS(HDISFILN))>0:$G(HDISDFFS(HDISFILN)),1:.01)
84 . I $$ADDFFNM^HDISVF05(HDISFILN,HDISFLDN,.HDISFIEN,.HDISERRM) D Q:HDISERRM'=""
85 . . S HDISFARY(HDISFIEN)=""
86 . ELSE D
87 . . ;Set error message, if unable to add file/field
88 . . S HDISERRM="Unable to Add File/Field "_HDISFILN_"~"_HDISFLDN_"."
89 ;
90 ;Set array for File/Field
91 S HDISFIEN=0
92 S HDISCNT=1
93 F S HDISFIEN=$O(HDISFARY(HDISFIEN)) Q:'HDISFIEN I $D(^HDIS(7115.6,HDISFIEN,0)) S HDISFFNM=$P(^(0),"^",1) D
94 . S HDISCNT=HDISCNT+1
95 . S HDISFDA(7115.11,"+"_HDISCNT_","_HDISDIEN_",",.01)=HDISFFNM
96 D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
97 ;Check for error
98 I $D(HDISMSG("DIERR")) D
99 . S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
100 ELSE D
101 . S HDISOKF=1
102ADDDFFSQ Q +$G(HDISOKF)
103 ;
104GETFILS(HDISDIEN,HDISCODE,HDISFILS) ;Get an Array of Files by Domain and Client Status Code
105 ; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
106 ; HDISCODE Client Status Code (Optional- Default 0=Not Started for Client)
107 ; Output -- 1=Successful and 0=Failure
108 ; If Successful:
109 ; HDISFILS Array Subscripted by File # (i.e. HDISFILS(120.8)="")
110 N HDISFIEN,HDISFILN,HDISFLDN
111 ;Initialize ouput
112 K HDISFILS
113 ;Check for missing variable, exit if not defined
114 I $G(HDISDIEN)'>0 G GETFILSQ
115 ;Set Status Code to default of 0=Not Started for Client, if needed
116 S HDISCODE=$S('$D(HDISCODE):0,1:HDISCODE)
117 ;Check Status of File/Fields and build array
118 S HDISFIEN=0
119 F S HDISFIEN=$O(^HDIS(7115.1,HDISDIEN,"FILE","B",HDISFIEN)) Q:'HDISFIEN D
120 . I $$GETFF^HDISVF05(HDISFIEN,.HDISFILN,.HDISFLDN),$P($$GETSTAT^HDISVF01(HDISFILN,HDISFLDN),"^",1)=HDISCODE D
121 . . S HDISFILS(HDISFILN)=""
122GETFILSQ Q +$S($D(HDISFILS):1,1:0)
123 ;
124GETIEN(HDISDOM,HDISDIEN) ;Get IEN for a Domain by Domain
125 ; Input -- HDISDOM Domain Name
126 ; Output -- 1=Successful and 0=Failure
127 ; If Successful:
128 ; HDISDIEN HDIS Domain file IEN
129 ;Initialize ouput
130 S HDISDIEN=""
131 ;Check for missing variable, exit if not defined
132 I $G(HDISDOM)="" G GETIENQ
133 ;Check for entry by Domain
134 S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
135GETIENQ Q +$S($G(HDISDIEN)>0:1,1:0)
136 ;
137 ;---- End HDIS Domain file (#7115.1) API(s) ----
138 ;
139 ;Error processing utility
140 ;
141ERR(HDISP1,HDISP2,HDISP3) ;
142 ;;Input: HDISP1 - Network Name (parameter 1 of bulletin)
143 ;; HDISP2 - Date/Time (parameter 2 of bulletin)
144 ;; HDISP3 - Error Message (parameter 3 of bulletin)
145 ;;Output: None
146 ;;
147 N HDISP,HDISTASK,NAME,ERRARR,HDISE
148 S HDISE="" S ERRARR="HDISE",HDISE(1)=""
149 S HDISP(1)=HDISP1
150 S Y=HDISP2 D DD^%DT S HDISP(2)=Y
151 S HDISP(3)=HDISP3
152 S NAME="HDIS ERRORS"
153 S HDISFLAG("FROM")="HDIS DS Client"
154 D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
155 I $G(XMERR) D
156 .;Error generating bulletin - log error text
157 .D ERR2XTMP^HDISVU01("HDI-XM","General error bulletin",$NA(^TMP("XMERR",$J)))
158 .K XMERR,^TMP("XMERR",$J)
159 Q
160 ;
161ERTBULL(HDISP1,HDISP2,HDISP3,HDISP4,HDISP5,HDISP6) ;
162 N ERRARR,HDISP,NAME,HDISFLAG,HDISTASK
163 S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
164 S HDISP(1)=HDISP1
165 S HDISP(2)=HDISP2
166 N Y S Y=HDISP3 D DD^%DT
167 S HDISP(3)=Y
168 S HDISP(4)=HDISP4
169 S HDISP(5)=HDISP5
170 S HDISP(6)=HDISP6
171 S NAME="HDIS NOTIFY ERT"
172 S HDISFLAG("FROM")="HDIS Data Standardization Server"
173 D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
174 I $G(XMERR) D
175 .;Error generating bulletin - log error text
176 .D ERR2XTMP^HDISVU01("HDI-XM","ERT bulletin",$NA(^TMP("XMERR",$J)))
177 .K XMERR,^TMP("XMERR",$J)
178 Q
179 ;
180MFSUP(HDISFILE,HDISERR,HDISFN) ; Update status to complete and send HDR Bulletin
181 ;;Input: HDISFILE - File Number of file just updated (Required)
182 ;; HDISERR - Error indicator from MFS (1 or 0) (Required)
183 ;; HDISFN - Field number (Optional)
184 ;;
185 ;;Output: None
186 N HDISCODE,HDISARRY,HDISOUT,HDISNM,HDISMESS,FILE,HDISTASK,NAME,OOPS,SYSTYPE,TMP
187 S HDISCODE=$$GETSTAT^HDISVF01(HDISFILE)
188 S FILE=HDISFILE
189 Q:$P(HDISCODE,"^",1)'=4&($P(HDISCODE,"^",1)'=5)
190 S HDISARRY=$NA(^TMP("HDIS STATUS",$J))
191 I $G(HDISERR) S HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),"Error from MFS") S HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,5,$$NOW^XLFDT(),HDISARRY,"") D SETSTAT^HDISVF01(HDISFILE,.01,5,$$NOW^XLFDT()) Q
192 S HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,6,$$NOW^XLFDT(),HDISARRY,"")
193 I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
194 D SETSTAT^HDISVF01(HDISFILE,.01,6,$$NOW^XLFDT())
195 I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
196 ;Notify HDR that triggers should be turned on
197 N FACPTR,FACNAME,FACNUM,DOMAIN,SYSTYP,FILENAME,HDISBDT
198 S OOPS=0
199 I '$$GETFAC^HDISVF07(,.FACPTR) S OOPS=1
200 I '$$GETDIP^HDISVF07(,.DOMAIN) S OOPS=1
201 I '$$GETTYPE^HDISVF07(,,.SYSTYPE) S OOPS=1
202 I OOPS=1 D
203 .S FACPTR=$$FACPTR^HDISVF01()
204 .S DOMAIN=$G(^XMB("NETNAME"))
205 .S SYSTYPE=$$PROD^XUPROD()
206 .S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
207 S TMP=$$NS^XUAF4(FACPTR)
208 S FACNAME=$P(TMP,"^",1)
209 S FACNUM=$P(TMP,"^",2)
210 I (FACNAME="")!(FACNUM="") D
211 .S TMP=$$SITE^VASITE()
212 .S FACNAME=$P(TMP,"^",2)
213 .S FACNUM=$P(TMP,"^",3)
214 S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_DOMAIN
215 S FILENAME=$$GET1^DID(FILE,,,"NAME")
216 S FILENAME=FILENAME_" (#"_FILE_")"
217 S HDISBDT=$$NOW^XLFDT()
218 S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
219 N HDISP
220 S HDISP(1)=FACNAME
221 S HDISP(2)=FILENAME
222 N Y S Y=$$NOW^XLFDT() D DD^%DT
223 S HDISP(3)=Y
224 S HDISP(4)=SYSTYPE
225 S HDISP(5)=FACNUM
226 S HDISP(6)=FILE
227 S NAME="HDIS NOTIFY HDR"
228 S HDISFLAG("FROM")="HDIS Data Standardization Server"
229 D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
230 I $G(XMERR) D
231 .;Error generating bulletin - log error text
232 .D ERR2XTMP^HDISVU01("HDI-XM","HDR bulletin",$NA(^TMP("XMERR",$J)))
233 .K XMERR,^TMP("XMERR",$J)
234 Q
Note: See TracBrowser for help on using the repository browser.