XUMFI0.m

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 ---XUMFI0   1781     printed  Mar 13, 2025@21:15:46                                                                                                                                                                                                      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      ;