source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUMFP.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
RevLine 
[628]1XUMFP ;CIOFO-SF/RAM,ALB/BRM - Master File C/S Parameters ; 10/11/02 2:50pm
2 ;;8.0;KERNEL;**206,217,246,262,369**;Jul 10, 1995;Build 27
3 ;
4 ;
5 ;
6MAIN(IFN,IEN,TYPE,PARAM,ERROR) ; -- parameters for master file server
7 ;
8 ;INPUT
9 ; IFN Internal File Number (required)
10 ;
11 ; IEN Internal Entry Number (required)
12 ;
13 ; single entry (pass by value) example: IEN=1
14 ;
15 ; multiple entries (pass by reference) IEN(1)=""
16 ; IEN(2)=""
17 ;
18 ; ALL national entries (pass by value) IEN="ALL"
19 ;
20 ; NEW entry (pass by value) IEN="NEW"
21 ;
22 ; TYPE Message TYPE (required)
23 ;
24 ; 0 = MFN - unsolicited update
25 ; 1 = MFQ - query particular record and file
26 ; 3 = MFQ - query particular record in array
27 ; 5 = MFQ - query group records file
28 ; 7 = MFQ - query group records array
29 ; 11 = MFR - query response particular rec file
30 ; 13 = MFR - query response particular rec array
31 ; 15 = MFR - query response group records file
32 ; 17 = MFR - query response group records array
33 ;
34 ;
35 ;INPUT/OUTPUT
36 ;
37 ; PARAM("PROTOCOL") IEN Protocol (#101) file
38 ; PARAM("LLNK") HLL("LINKS",n) 'protocol^logical link'
39 ; PARAM("PRE") Pre-update record routine
40 ; PARAM("POST") Post-update record routine
41 ;
42 ; QRD -- Query definition segment
43 ; -------------------------------
44 ; PARAM("QDT") Query Date/Time
45 ; PARAM("QFC") Query Format Code
46 ; PARAM("QP") Query Priority
47 ; PARAM("QID") Query ID
48 ; PARAM("DRT") Deferred Response Type
49 ; PARAM("DRDT") Deferred Response Date/Time
50 ; PARAM("QLR") Quantity Limited Request
51 ; PARAM("WHO") Who Subject Filter
52 ; PARAM("WHAT") What Subject Filter
53 ; PARAM("WDDC") What Department Data Code
54 ; PARAM("WDCVQ") What Data Code Value Qual
55 ; PARAM("QRL") Query Results Level
56 ;
57 ; MFI -- Master File Identification
58 ; ---------------------------------
59 ; PARAM("MFI") Master File Identifier
60 ; PARAM("MFAI") Master File Application Identifier
61 ; PARAM("FLEC") File-Level Event Code
62 ; PARAM("ENDT") Entered Data/Time
63 ; PARAM("MFIEDT") Effective Date/Time
64 ; PARAM("RLC") Response Level Code
65 ;
66 ; MFE -- Master File Entry
67 ; ------------------------
68 ; PARAM("RLEC") Record-Level Event Code
69 ; PARAM("MFNCID") MFN Control ID
70 ; PARAM("MFEEDT") Effective Date/Time
71 ; PARAM("PKV") Primary Key Value
72 ;
73 ; [Z...] segment(s) parameters
74 ; -------------------------
75 ; PARAM("SEG",SEG)="" HL7 segment name
76 ; PARAM("SEG",SEG,"SEQ",SEQ,FLD#) seg sequence number and field
77 ; Note: Add HL7 data type + sub components (leave value/code blank)
78 ; Example: Institution Facility Type = "CE^~FACILILITY TYPE~VA"
79 ; If the FIELD is a pointer and you want the lookup to be other
80 ; than the pointed to .01 set the 3rd piece = to the extended ref.
81 ; I.e., Parent Facility in the Association mult of Institution
82 ; points back to Institution, if we want to get facility using
83 ; station number (#99) instead of name (.01) set the 3rd piece
84 ; equal to ":99" giving us "CE^~FACILILITY TYPE~VA^:99".
85 ;
86 ; Files involving sub-records and/or extended reference
87 ; -----------------------------------------------------
88 ; PARAM("SEG",SEG,"SEQ",SEQ,"FILE") See FM documentation
89 ; PARAM("SEG",SEG,"SEQ",SEQ,"IENS") $$GET1^DIQ() for value
90 ; PARAM("SEG",SEG,"SEQ",SEQ,"FIELD") of FILE, IENS, & FIELD.
91 ;
92 ; PARAM("SEG",SEG,"SEQ",SEQ,"DTYP") HL7 data type (above)
93 ;
94 ;
95 ; *** NOTE: OUTPUT in ^TMP("XUMF MFS",$J,"PARAM") ***
96 ;
97 ; Example: MFE PKV is ^TMP("XUMF MFS",$J,"PARAM",IEN,"PKV")
98 ; SEG ^TMP("XUMF MFS",$J,"PARAM","SEG")
99 ;
100 ; and another node is required for sub-file IENS for group
101 ; ^TMP("XUMF MFS",$J,"PARAM",IEN,"IENS",SEG,SEQ)=IENS
102 ;
103 ; Use XUMFP4 as a template/example routine
104 ;
105 N QUERY,UPDATE,ALL,MFR,MFQ,HLFS,HLCS,GROUP,ARRAY,ROOT,NEW,I,J,CDSYS
106 N PROTOCOL
107 ;
108 K ^TMP("XUMF MFS",$J)
109 M ^TMP("XUMF MFS",$J,"PARAM")=PARAM
110 ;
111 S IEN=$G(IEN),IFN=$G(IFN)
112 S TYPE=+$G(TYPE),ERROR=$G(ERROR)
113 S UPDATE=$S(TYPE#2:0,1:1)
114 S QUERY='UPDATE
115 S GROUP=$S(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
116 S ARRAY=$S(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
117 S ALL=$S(IEN="ALL":1,1:0)
118 S NEW=$S(IEN="NEW":1,1:0)
119 S MFR=$S(UPDATE:0,TYPE>10:1,1:0)
120 S MFQ=$S(UPDATE:0,'MFR:1,1:0)
121 ;
122 S PROTOCOL=$G(PARAM("PROTOCOL"))
123 ;
124 I 'IFN S ERROR="1^invalid IFN" Q
125 ;
126 ; -- get root of file
127 S ROOT=$$ROOT^DILFD(IFN,,1)
128 ;
129 ; -- if IEN array input, merge with param
130 I 'ALL,'IEN,$O(IEN(0)) M ^TMP("XUMF MFS",$J,"PARAM","IEN")=IEN
131 ;
132 ; -- if CDSYS and ALL get entries
133 S CDSYS=$G(^TMP("XUMF MFS",$J,"PARAM","CDSYS"))
134 I ALL,CDSYS'="" D
135 .S I=0 F S I=$O(@ROOT@("XUMFIDX",CDSYS,I)) Q:'I D
136 ..S J=$O(@ROOT@("XUMFIDX",CDSYS,I,0))
137 ..S ^TMP("XUMF MFS",$J,"PARAM","IEN",J)=I
138 ;
139 ; -- get ALL file 'national' entries
140 I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")),CDSYS="" D
141 .S I=0 F S I=$O(@ROOT@("XUMF","N",I)) Q:'I D
142 ..S ^TMP("XUMF MFS",$J,"PARAM","IEN",I)=""
143 ;
144 ; -- get ALL file
145 I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")),CDSYS="" D
146 .S I=0 F S I=$O(@ROOT@(I)) Q:'I D
147 ..S ^TMP("XUMF MFS",$J,"PARAM","IEN",I)=""
148 ;
149 ; *** insert code below ***
150 ; insert file number in string below to add an additional file
151 I "^4^4.1^5.12^5.13^730^5^45.7^4.11^49^9.8^"'[(U_IFN_U) S ERROR="1^file not supported" Q
152 ; *** end insert code ***
153 ;
154 ; note: also create a subroutine for each supported file with
155 ; the file number as the line TAG (replace decimal point
156 ; of file number with the letter 'P'). This subroutine
157 ; calls an associated routine for the specific file.
158 ; This file should use the XUMFP namespace.
159 ;
160 I "^4^4.1^5.12^5.13^"[(U_IFN_U) D @("F"_$TR(IFN,".","P"))
161 I "^730^5^4.11^49^9.8^"[(U_IFN_U) D ZL7
162 ;
163 K PARAM
164 ;
165 Q
166 ;
167F4 ; -- institution file
168 ;
169 D ^XUMFP4
170 ;
171 Q
172 ;
173F4P1 ; -- facility type file
174 ;
175 D ^XUMFPFT
176 ;
177 Q
178 ;
179F5P12 ; -- postal code file
180 ;
181 D ^XUMFP512
182 ;
183 Q
184 ;
185F5P13 ; -- county code file
186 ;
187 D ^XUMFP513
188 ;
189 Q
190 ;
191 ; *** insert subroutine here for additional files ***
192 ;
193TAG ;D ^ROUTINE
194 ;Q
195 ;
196 ;
197ZL7 ; generic
198 ;
199 D ^XUMFPMFS
200 ;
201 Q
202 ;
203MFI(X) ; -- master file identifier function
204 ;
205 ;INPUT X master file indentifier (seq 1 MFI segment)
206 ;OUTPUT $$ IFN - Internal File Number or '0' for error
207 ;
208 Q:X="Z04" 4
209 Q:X="Z4T" 4.1
210 Q:$P(X,HLCS)="5P12" 5.12
211 Q:$P(X,HLCS)="5P13" 5.13
212 Q:X="ZNS" 730
213 Q:X="ZAG" 4.11
214 Q:X="Z05" 5
215 Q:X="Z49" 49
216 ;
217 ; *** add code here for new files ***
218 ;
219 Q 0
220 ;
221DTYP(VALUE,TYP,HLCS,TOHL7) ;data type conversion
222 ;INPUT
223 ; VALUE value
224 ; TYP HL7 data type
225 ; TOHL7 1=to HL7, 0=to FileMan
226 ;OUTPUT
227 ; $$ formatted data
228 ;
229 N TEXT,CS
230 S TYP=$G(TYP),VALUE=$G(VALUE),TOHL7=$G(TOHL7)
231 Q:TYP="" VALUE Q:VALUE="" VALUE
232 S TEXT=$P(TYP,U,2),TYP=$P(TYP,U)
233 I TYP="ST"!(TYP="ID") Q VALUE
234 I TYP="DT",TOHL7 D Q $$HLDATE^HLFNC(VALUE)
235 .N X,Y S X=VALUE D ^%DT S VALUE=+Y
236 I TYP="DT" Q $$FMDATE^HLFNC(+VALUE)
237 I TYP="ZST" D Q VALUE
238 .N IEN5 S IEN5=+$O(^DIC(5,"C",VALUE,""))
239 .S:IEN5 VALUE=$P($G(^DIC(5,IEN5,0)),"^")
240 I 'TOHL7 Q $P(VALUE,HLCS)
241 Q VALUE_$TR(TEXT,"~",HLCS)
242 ;
Note: See TracBrowser for help on using the repository browser.