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

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1XUMFI0 ;CIOFO-SF/RAM - Master File Interface ;06/28/00
2 ;;8.0;KERNEL;**369,416**;Jul 10, 1995;Build 5
3 ;
4 Q
5 ;
6INIT ; -- initialize
7 ;
8 K ^TMP("DILIST",$J),^TMP("DIERR",$J)
9 K ^TMP("HLS",$J),^TMP("HLA",$J)
10 ;
11 S IEN=$G(IEN),IFN=$G(IFN)
12 S TYPE=$G(TYPE),ERROR=$G(ERROR),CNT=1
13 S UPDATE=$S(TYPE#2:0,1:1)
14 S QUERY='UPDATE
15 S GROUP=$S(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
16 S ARRAY=$S(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
17 S ALL=$S(IEN["ALL":1,1:0)
18 S PROTOCOL=$G(^TMP("XUMF MFS",$J,"PARAM","PROTOCOL"))
19 S MFR=$S(UPDATE:0,TYPE>10:1,1:0)
20 S MFQ=$S(UPDATE:0,'MFR:1,1:0)
21 S MFK=$S(TYPE=10:1,1:0)
22 S MTYP=$S(MFR:"HLA",MFK:"HLA",1:"HLS")
23 ;
24 ; -- get variables from HL7 package
25 I $O(HL(""))="" D INIT^HLFNC2(PROTOCOL,.HL)
26 I $O(HL(""))="" S ERROR="1^"_$P(HL,"^",2) Q
27 S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4)
28 ;
29 Q:ERROR
30 I UPDATE,'IEN,TYPE=10 Q
31 ;
32 ; -- check parameters
33 I 'QUERY,'UPDATE S ERROR="1^invalid message type" Q
34 I 'IFN S ERROR="1^invalid file number" Q
35 I 'IEN,'ALL,'MFK S ERROR="1^invalid IEN" Q
36 I '$$VFILE^DILFD(IFN) S ERROR="1^invalid file number" Q
37 I UPDATE,'IEN S ERROR="1^update message requires an IEN" Q
38 ;
39 ; -- get root of file
40 S ROOT=$$ROOT^DILFD(IFN,,1)
41 ;
42 ; -- if IEN array input, merge with param
43 I 'ALL,'IEN,$O(IEN(0)) M ^TMP("XUMF MFS",$J,"PARAM","IEN")=IEN
44 ;
45 ; -- if CDSYS and ALL get entries
46 S CDSYS=$G(^TMP("XUMF MFS",$J,"PARAM","CDSYS"))
47 I ALL,CDSYS'="" D
48 .S I=0 F S I=$O(@ROOT@("XUMFIDX",CDSYS,I)) Q:'I D
49 ..S J=$O(@ROOT@("XUMFIDX",CDSYS,I,0))
50 ..S ^TMP("XUMF MFS",$J,"PARAM","IEN",J)=""
51 ;
52 ; -- get ALL file 'national' entries
53 I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")) D
54 .S I=0 F S I=$O(@ROOT@("XUMF","N",I)) Q:'I D
55 ..S ^TMP("XUMF MFS",$J,"PARAM","IEN",I)=""
56 ;
57 Q
58 ;
Note: See TracBrowser for help on using the repository browser.