XUMFHPR.m

XUMFHPR ;OIFO-OAK/RAM - Master File Parameters client Handler ;06/28/00

 ;;8.0;KERNEL;**299**;Jul 10, 1995

 ;

 ; This routine handles Master File Parameters file updates.

 ;

MAIN ; -- entry point

 ;

 N ERR,HLFS,HLCS,ERROR,IEN,KEY,MID,REASON,VALUE

 ;

 D INIT,PROCESS,EXIT

 ;

 Q

 ;

INIT ; -- initialize

 ;

 K ^TMP("DILIST",$J),^TMP("DIERR",$J)

 K ^TMP("HLS",$J),^TMP("HLA",$J)

 ;

 S ERROR=0,HLFS=HL("FS"),HLCS=$E(HL("ECH"))

 ;

 Q

 ;

PROCESS ; -- pull message text

 ;

 F  X HLNEXT Q:HLQUIT'>0  D

 .Q:$P(HLNODE,HLFS)=""

 .D @($P(HLNODE,HLFS))

 ;

 Q

 ;

MSH ; -- MSH segment

 ;

 Q

 ;

MSA ; -- MSA segment

 ;

 N CODE

 ;

 S CODE=$P(HLNODE,HLFS,2)

 ;

 I CODE="AE"!(CODE="AR") D

 .S ERROR=ERROR_U_$P(HLNODE,HLFS,4)_U_$G(ERR)

 .D EM(ERROR,.ERR)

 ;

 Q

 ;

QRD ; -- QRD segment

 ;

 Q

 ;

MFI ; -- MFI segment

 ;

 Q

 ;

MFE ; -- MFE segment

 ;

 Q:ERROR

 ;

 S KEY=$P($P(HLNODE,HLFS,5),HLCS)

 ;

 S IEN=$$FIND1^DIC(1,,"X",KEY,"B")

 ;

 I 'IEN D  Q

 .D EM("Error - no IEN in MFE XUMFH",.ERR)

 .K ERR

 ;

 Q

 ;

ZMF ; -- ZMF segment

 ;

 Q:ERROR

 ;

 N FDA,IENS,FIELD,ERR,XUMF,SEQ,X

 ;

 S XUMF=1

 ;

 K FDA

 S IENS=IEN_","

 ;

 ;zero node

 F SEQ=2:1:6 D

 .S FIELD=".0"_SEQ

 .S VALUE=$P(HLNODE,HLFS,SEQ+1)

 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 .S FDA(4.001,IENS,FIELD)=VALUE

 ;

 ;mfe node

 F SEQ=1:1:9 D

 .S FIELD="4."_SEQ

 .S VALUE=$P(HLNODE,HLFS,SEQ+7)

 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 .S FDA(4.001,IENS,FIELD)=VALUE

 F SEQ=1,2,4:1:7 D

 .S FIELD="4.1"_SEQ

 .S VALUE=$P(HLNODE,HLFS,SEQ+16)

 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 .S FDA(4.001,IENS,FIELD)=VALUE

 ;

 D FILE^DIE("E","FDA","ERR")

 I $D(ERR) D

 .D EM("FILE DIE call error message in ZZZ XUMFHPR",.ERR)

 .K ERR

 ;

 K FDA

 S SEQ=0

 F  S SEQ=$O(^DIC(4.001,IEN,1,SEQ)) Q:'SEQ  D

 .S IENS=SEQ_","_IEN_","

 .S FDA(4.011,IENS,.01)="@"

 ;

 D FILE^DIE("E","FDA")

 ;

 Q

 ;

ZZS ; -- SEQUENCE segments

 ;

 Q:ERROR

 ;

 N FDA,IENS,FIELD,ERR,XUMF,SEQ

 ;

 S XUMF=1

 ;

 S IENS="?+"_+$P(HLNODE,HLFS,2)_","_IEN_","

 ;

 F I=1:1:9 D

 .S FIELD=".0"_I

 .S VALUE=$P(HLNODE,HLFS,I+1)

 .S VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 .S FDA(4.011,IENS,FIELD)=VALUE

 ;

 D UPDATE^DIE("E","FDA",,"ERR")

 I $D(ERR) D

 .D EM("UPDATE DIE call error message in ZZS XUMFHPR",.ERR)

 .K ERR

 ;

 Q

 ;

EXIT ; -- cleanup, and quit

 ;

 K ^TMP("DILIST",$J),^TMP("DIERR",$J),^TMP("HLS",$J),^TMP("HLA",$J)

 K ^TMP("XUMF MFS",$J)

 ;

 Q

 ;

EM(ERROR,ERR,XMSUB,XMY) ; -- error message

 ;

 N X,XMTEXT

 ;

 D MSG^DIALOG("AM",.X,80,,"ERR")

 ;

 S X(.1)="HL7 message ID: "_$G(HL("MID"))

 S X(.2)="",X(.3)=$G(ERROR),X(.4)=""

 S:$G(XMSUB)="" XMSUB="MFS ERROR"

 S XMY("G.XUMF ERROR")="",XMDUZ=.5

 S XMTEXT="X("

 ;

 D ^XMD

 ;

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XUMFHPR   2779     printed  Mar 13, 2025@21:15:44                                                                                                                                                                                                     Page 2

XUMFHPR   ;OIFO-OAK/RAM - Master File Parameters client Handler ;06/28/00

 +1       ;;8.0;KERNEL;**299**;Jul 10, 1995

 +2       ;

 +3       ; This routine handles Master File Parameters file updates.

 +4       ;

MAIN      ; -- entry point

 +1       ;

 +2        NEW ERR,HLFS,HLCS,ERROR,IEN,KEY,MID,REASON,VALUE

 +3       ;

 +4        DO INIT

           DO PROCESS

           DO EXIT

 +5       ;

 +6        QUIT 

 +7       ;

INIT      ; -- initialize

 +1       ;

 +2        KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)

 +3        KILL ^TMP("HLS",$JOB),^TMP("HLA",$JOB)

 +4       ;

 +5        SET ERROR=0

           SET HLFS=HL("FS")

           SET HLCS=$EXTRACT(HL("ECH"))

 +6       ;

 +7        QUIT 

 +8       ;

PROCESS   ; -- pull message text

 +1       ;

 +2        FOR 

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +3                if $PIECE(HLNODE,HLFS)=""

                       QUIT 

 +4                DO @($PIECE(HLNODE,HLFS))

               End DoDot:1

 +5       ;

 +6        QUIT 

 +7       ;

MSH       ; -- MSH segment

 +1       ;

 +2        QUIT 

 +3       ;

MSA       ; -- MSA segment

 +1       ;

 +2        NEW CODE

 +3       ;

 +4        SET CODE=$PIECE(HLNODE,HLFS,2)

 +5       ;

 +6        IF CODE="AE"!(CODE="AR")

               Begin DoDot:1

 +7                SET ERROR=ERROR_U_$PIECE(HLNODE,HLFS,4)_U_$GET(ERR)

 +8                DO EM(ERROR,.ERR)

               End DoDot:1

 +9       ;

 +10       QUIT 

 +11      ;

QRD       ; -- QRD segment

 +1       ;

 +2        QUIT 

 +3       ;

MFI       ; -- MFI segment

 +1       ;

 +2        QUIT 

 +3       ;

MFE       ; -- MFE segment

 +1       ;

 +2        if ERROR

               QUIT 

 +3       ;

 +4        SET KEY=$PIECE($PIECE(HLNODE,HLFS,5),HLCS)

 +5       ;

 +6        SET IEN=$$FIND1^DIC(1,,"X",KEY,"B")

 +7       ;

 +8        IF 'IEN

               Begin DoDot:1

 +9                DO EM("Error - no IEN in MFE XUMFH",.ERR)

 +10               KILL ERR

               End DoDot:1

               QUIT 

 +11      ;

 +12       QUIT 

 +13      ;

ZMF       ; -- ZMF segment

 +1       ;

 +2        if ERROR

               QUIT 

 +3       ;

 +4        NEW FDA,IENS,FIELD,ERR,XUMF,SEQ,X

 +5       ;

 +6        SET XUMF=1

 +7       ;

 +8        KILL FDA

 +9        SET IENS=IEN_","

 +10      ;

 +11      ;zero node

 +12       FOR SEQ=2:1:6

               Begin DoDot:1

 +13               SET FIELD=".0"_SEQ

 +14               SET VALUE=$PIECE(HLNODE,HLFS,SEQ+1)

 +15               SET VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 +16               SET FDA(4.001,IENS,FIELD)=VALUE

               End DoDot:1

 +17      ;

 +18      ;mfe node

 +19       FOR SEQ=1:1:9

               Begin DoDot:1

 +20               SET FIELD="4."_SEQ

 +21               SET VALUE=$PIECE(HLNODE,HLFS,SEQ+7)

 +22               SET VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 +23               SET FDA(4.001,IENS,FIELD)=VALUE

               End DoDot:1

 +24       FOR SEQ=1,2,4:1:7

               Begin DoDot:1

 +25               SET FIELD="4.1"_SEQ

 +26               SET VALUE=$PIECE(HLNODE,HLFS,SEQ+16)

 +27               SET VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 +28               SET FDA(4.001,IENS,FIELD)=VALUE

               End DoDot:1

 +29      ;

 +30       DO FILE^DIE("E","FDA","ERR")

 +31       IF $DATA(ERR)

               Begin DoDot:1

 +32               DO EM("FILE DIE call error message in ZZZ XUMFHPR",.ERR)

 +33               KILL ERR

               End DoDot:1

 +34      ;

 +35       KILL FDA

 +36       SET SEQ=0

 +37       FOR 

               SET SEQ=$ORDER(^DIC(4.001,IEN,1,SEQ))

               if 'SEQ

                   QUIT 

               Begin DoDot:1

 +38               SET IENS=SEQ_","_IEN_","

 +39               SET FDA(4.011,IENS,.01)="@"

               End DoDot:1

 +40      ;

 +41       DO FILE^DIE("E","FDA")

 +42      ;

 +43       QUIT 

 +44      ;

ZZS       ; -- SEQUENCE segments

 +1       ;

 +2        if ERROR

               QUIT 

 +3       ;

 +4        NEW FDA,IENS,FIELD,ERR,XUMF,SEQ

 +5       ;

 +6        SET XUMF=1

 +7       ;

 +8        SET IENS="?+"_+$PIECE(HLNODE,HLFS,2)_","_IEN_","

 +9       ;

 +10       FOR I=1:1:9

               Begin DoDot:1

 +11               SET FIELD=".0"_I

 +12               SET VALUE=$PIECE(HLNODE,HLFS,I+1)

 +13               SET VALUE=$$DTYP^XUMFP(VALUE,"ST",HLCS,0)

 +14               SET FDA(4.011,IENS,FIELD)=VALUE

               End DoDot:1

 +15      ;

 +16       DO UPDATE^DIE("E","FDA",,"ERR")

 +17       IF $DATA(ERR)

               Begin DoDot:1

 +18               DO EM("UPDATE DIE call error message in ZZS XUMFHPR",.ERR)

 +19               KILL ERR

               End DoDot:1

 +20      ;

 +21       QUIT 

 +22      ;

EXIT      ; -- cleanup, and quit

 +1       ;

 +2        KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB),^TMP("HLS",$JOB),^TMP("HLA",$JOB)

 +3        KILL ^TMP("XUMF MFS",$JOB)

 +4       ;

 +5        QUIT 

 +6       ;

EM(ERROR,ERR,XMSUB,XMY) ; -- error message

 +1       ;

 +2        NEW X,XMTEXT

 +3       ;

 +4        DO MSG^DIALOG("AM",.X,80,,"ERR")

 +5       ;

 +6        SET X(.1)="HL7 message ID: "_$GET(HL("MID"))

 +7        SET X(.2)=""

           SET X(.3)=$GET(ERROR)

           SET X(.4)=""

 +8        if $GET(XMSUB)=""

               SET XMSUB="MFS ERROR"

 +9        SET XMY("G.XUMF ERROR")=""

           SET XMDUZ=.5

 +10       SET XMTEXT="X("

 +11      ;

 +12       DO ^XMD

 +13      ;

 +14       QUIT 

 +15      ;