| [613] | 1 | XUMFI0 ;CIOFO-SF/RAM - Master File Interface ;06/28/00
|
|---|
| 2 | ;;8.0;KERNEL;**369,416**;Jul 10, 1995;Build 5
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | INIT ; -- 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 | ;
|
|---|
