XUMFI0 ;CIOFO-SF/RAM - Master File Interface ;06/28/00
;;8.0;KERNEL;**369,416**;Jul 10, 1995;Build 5
;
Q
;
INIT ; -- initialize
;
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
K ^TMP("HLS",$J),^TMP("HLA",$J)
;
S IEN=$G(IEN),IFN=$G(IFN)
S TYPE=$G(TYPE),ERROR=$G(ERROR),CNT=1
S UPDATE=$S(TYPE#2:0,1:1)
S QUERY='UPDATE
S GROUP=$S(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
S ARRAY=$S(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
S ALL=$S(IEN["ALL":1,1:0)
S PROTOCOL=$G(^TMP("XUMF MFS",$J,"PARAM","PROTOCOL"))
S MFR=$S(UPDATE:0,TYPE>10:1,1:0)
S MFQ=$S(UPDATE:0,'MFR:1,1:0)
S MFK=$S(TYPE=10:1,1:0)
S MTYP=$S(MFR:"HLA",MFK:"HLA",1:"HLS")
;
; -- get variables from HL7 package
I $O(HL(""))="" D INIT^HLFNC2(PROTOCOL,.HL)
I $O(HL(""))="" S ERROR="1^"_$P(HL,"^",2) Q
S HLFS=HL("FS"),HLCS=$E(HL("ECH")),HLSCS=$E(HL("ECH"),4)
;
Q:ERROR
I UPDATE,'IEN,TYPE=10 Q
;
; -- check parameters
I 'QUERY,'UPDATE S ERROR="1^invalid message type" Q
I 'IFN S ERROR="1^invalid file number" Q
I 'IEN,'ALL,'MFK S ERROR="1^invalid IEN" Q
I '$$VFILE^DILFD(IFN) S ERROR="1^invalid file number" Q
I UPDATE,'IEN S ERROR="1^update message requires an IEN" Q
;
; -- get root of file
S ROOT=$$ROOT^DILFD(IFN,,1)
;
; -- if IEN array input, merge with param
I 'ALL,'IEN,$O(IEN(0)) M ^TMP("XUMF MFS",$J,"PARAM","IEN")=IEN
;
; -- if CDSYS and ALL get entries
S CDSYS=$G(^TMP("XUMF MFS",$J,"PARAM","CDSYS"))
I ALL,CDSYS'="" D
.S I=0 F S I=$O(@ROOT@("XUMFIDX",CDSYS,I)) Q:'I D
..S J=$O(@ROOT@("XUMFIDX",CDSYS,I,0))
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",J)=""
;
; -- get ALL file 'national' entries
I ALL,'$D(^TMP("XUMF MFS",$J,"PARAM","IEN")) D
.S I=0 F S I=$O(@ROOT@("XUMF","N",I)) Q:'I D
..S ^TMP("XUMF MFS",$J,"PARAM","IEN",I)=""
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMFI0 1781 printed Dec 13, 2024@02:10:51 Page 2
XUMFI0 ;CIOFO-SF/RAM - Master File Interface ;06/28/00
+1 ;;8.0;KERNEL;**369,416**;Jul 10, 1995;Build 5
+2 ;
+3 QUIT
+4 ;
INIT ; -- initialize
+1 ;
+2 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+3 KILL ^TMP("HLS",$JOB),^TMP("HLA",$JOB)
+4 ;
+5 SET IEN=$GET(IEN)
SET IFN=$GET(IFN)
+6 SET TYPE=$GET(TYPE)
SET ERROR=$GET(ERROR)
SET CNT=1
+7 SET UPDATE=$SELECT(TYPE#2:0,1:1)
+8 SET QUERY='UPDATE
+9 SET GROUP=$SELECT(UPDATE:0,TYPE[5:1,TYPE[7:1,1:0)
+10 SET ARRAY=$SELECT(UPDATE:0,TYPE[3:1,TYPE[7:1,1:0)
+11 SET ALL=$SELECT(IEN["ALL":1,1:0)
+12 SET PROTOCOL=$GET(^TMP("XUMF MFS",$JOB,"PARAM","PROTOCOL"))
+13 SET MFR=$SELECT(UPDATE:0,TYPE>10:1,1:0)
+14 SET MFQ=$SELECT(UPDATE:0,'MFR:1,1:0)
+15 SET MFK=$SELECT(TYPE=10:1,1:0)
+16 SET MTYP=$SELECT(MFR:"HLA",MFK:"HLA",1:"HLS")
+17 ;
+18 ; -- get variables from HL7 package
+19 IF $ORDER(HL(""))=""
DO INIT^HLFNC2(PROTOCOL,.HL)
+20 IF $ORDER(HL(""))=""
SET ERROR="1^"_$PIECE(HL,"^",2)
QUIT
+21 SET HLFS=HL("FS")
SET HLCS=$EXTRACT(HL("ECH"))
SET HLSCS=$EXTRACT(HL("ECH"),4)
+22 ;
+23 if ERROR
QUIT
+24 IF UPDATE
IF 'IEN
IF TYPE=10
QUIT
+25 ;
+26 ; -- check parameters
+27 IF 'QUERY
IF 'UPDATE
SET ERROR="1^invalid message type"
QUIT
+28 IF 'IFN
SET ERROR="1^invalid file number"
QUIT
+29 IF 'IEN
IF 'ALL
IF 'MFK
SET ERROR="1^invalid IEN"
QUIT
+30 IF '$$VFILE^DILFD(IFN)
SET ERROR="1^invalid file number"
QUIT
+31 IF UPDATE
IF 'IEN
SET ERROR="1^update message requires an IEN"
QUIT
+32 ;
+33 ; -- get root of file
+34 SET ROOT=$$ROOT^DILFD(IFN,,1)
+35 ;
+36 ; -- if IEN array input, merge with param
+37 IF 'ALL
IF 'IEN
IF $ORDER(IEN(0))
MERGE ^TMP("XUMF MFS",$JOB,"PARAM","IEN")=IEN
+38 ;
+39 ; -- if CDSYS and ALL get entries
+40 SET CDSYS=$GET(^TMP("XUMF MFS",$JOB,"PARAM","CDSYS"))
+41 IF ALL
IF CDSYS'=""
Begin DoDot:1
+42 SET I=0
FOR
SET I=$ORDER(@ROOT@("XUMFIDX",CDSYS,I))
if 'I
QUIT
Begin DoDot:2
+43 SET J=$ORDER(@ROOT@("XUMFIDX",CDSYS,I,0))
+44 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",J)=""
End DoDot:2
End DoDot:1
+45 ;
+46 ; -- get ALL file 'national' entries
+47 IF ALL
IF '$DATA(^TMP("XUMF MFS",$JOB,"PARAM","IEN"))
Begin DoDot:1
+48 SET I=0
FOR
SET I=$ORDER(@ROOT@("XUMF","N",I))
if 'I
QUIT
Begin DoDot:2
+49 SET ^TMP("XUMF MFS",$JOB,"PARAM","IEN",I)=""
End DoDot:2
End DoDot:1
+50 ;
+51 QUIT
+52 ;
