source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMFHPR.m@ 824

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

initial load of WorldVistAEHR
File size: 2.6 KB
Line 
1XUMFHPR ;OIFO-OAK/RAM - Master File Parameters client Handler ;06/28/00
2 ;;8.0;KERNEL;**299**;Jul 10, 1995
3 ;
4 ; This routine handles Master File Parameters file updates.
5 ;
6MAIN ; -- entry point
7 ;
8 N ERR,HLFS,HLCS,ERROR,IEN,KEY,MID,REASON,VALUE
9 ;
10 D INIT,PROCESS,EXIT
11 ;
12 Q
13 ;
14INIT ; -- initialize
15 ;
16 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
17 K ^TMP("HLS",$J),^TMP("HLA",$J)
18 ;
19 S ERROR=0,HLFS=HL("FS"),HLCS=$E(HL("ECH"))
20 ;
21 Q
22 ;
23PROCESS ; -- pull message text
24 ;
25 F X HLNEXT Q:HLQUIT'>0 D
26 .Q:$P(HLNODE,HLFS)=""
27 .D @($P(HLNODE,HLFS))
28 ;
29 Q
30 ;
31MSH ; -- MSH segment
32 ;
33 Q
34 ;
35MSA ; -- MSA segment
36 ;
37 N CODE
38 ;
39 S CODE=$P(HLNODE,HLFS,2)
40 ;
41 I CODE="AE"!(CODE="AR") D
42 .S ERROR=ERROR_U_$P(HLNODE,HLFS,4)_U_$G(ERR)
43 .D EM(ERROR,.ERR)
44 ;
45 Q
46 ;
47QRD ; -- QRD segment
48 ;
49 Q
50 ;
51MFI ; -- MFI segment
52 ;
53 Q
54 ;
55MFE ; -- MFE segment
56 ;
57 Q:ERROR
58 ;
59 S KEY=$P($P(HLNODE,HLFS,5),HLCS)
60 ;
61 S IEN=$$FIND1^DIC(1,,"X",KEY,"B")
62 ;
63 I 'IEN D Q
64 .D EM("Error - no IEN in MFE XUMFH",.ERR)
65 .K ERR
66 ;
67 Q
68 ;
69ZMF ; -- ZMF segment
70 ;
71 Q:ERROR
72 ;
73 N FDA,IENS,FIELD,ERR,XUMF,SEQ,X
74 ;
75 S XUMF=1
76 ;
77 K FDA
78 S IENS=IEN_","
79 ;
80 ;zero node
81 F SEQ=2:1:6 D
82 .S FIELD=".0"_SEQ
83 .S VALUE=$P(HLNODE,HLFS,SEQ+1)
84 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)
85 .S FDA(4.001,IENS,FIELD)=VALUE
86 ;
87 ;mfe node
88 F SEQ=1:1:9 D
89 .S FIELD="4."_SEQ
90 .S VALUE=$P(HLNODE,HLFS,SEQ+7)
91 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)
92 .S FDA(4.001,IENS,FIELD)=VALUE
93 F SEQ=1,2,4:1:7 D
94 .S FIELD="4.1"_SEQ
95 .S VALUE=$P(HLNODE,HLFS,SEQ+16)
96 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)
97 .S FDA(4.001,IENS,FIELD)=VALUE
98 ;
99 D FILE^DIE("E","FDA","ERR")
100 I $D(ERR) D
101 .D EM("FILE DIE call error message in ZZZ XUMFHPR",.ERR)
102 .K ERR
103 ;
104 K FDA
105 S SEQ=0
106 F S SEQ=$O(^DIC(4.001,IEN,1,SEQ)) Q:'SEQ D
107 .S IENS=SEQ_","_IEN_","
108 .S FDA(4.011,IENS,.01)="@"
109 ;
110 D FILE^DIE("E","FDA")
111 ;
112 Q
113 ;
114ZZS ; -- SEQUENCE segments
115 ;
116 Q:ERROR
117 ;
118 N FDA,IENS,FIELD,ERR,XUMF,SEQ
119 ;
120 S XUMF=1
121 ;
122 S IENS="?+"_+$P(HLNODE,HLFS,2)_","_IEN_","
123 ;
124 F I=1:1:9 D
125 .S FIELD=".0"_I
126 .S VALUE=$P(HLNODE,HLFS,I+1)
127 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)
128 .S FDA(4.011,IENS,FIELD)=VALUE
129 ;
130 D UPDATE^DIE("E","FDA",,"ERR")
131 I $D(ERR) D
132 .D EM("UPDATE DIE call error message in ZZS XUMFHPR",.ERR)
133 .K ERR
134 ;
135 Q
136 ;
137EXIT ; -- cleanup, and quit
138 ;
139 K ^TMP("DILIST",$J),^TMP("DIERR",$J),^TMP("HLS",$J),^TMP("HLA",$J)
140 K ^TMP("XUMF MFS",$J)
141 ;
142 Q
143 ;
144EM(ERROR,ERR,XMSUB,XMY) ; -- error message
145 ;
146 N X,XMTEXT
147 ;
148 D MSG^DIALOG("AM",.X,80,,"ERR")
149 ;
150 S X(.1)="HL7 message ID: "_$G(HL("MID"))
151 S X(.2)="",X(.3)=$G(ERROR),X(.4)=""
152 S:$G(XMSUB)="" XMSUB="MFS ERROR"
153 S XMY("G.XUMF ERROR")="",XMDUZ=.5
154 S XMTEXT="X("
155 ;
156 D ^XMD
157 ;
158 Q
159 ;
Note: See TracBrowser for help on using the repository browser.