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 ---[H[J[2J[HXUMFHPR 2779 printed Dec 13, 2024@02:10:49 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 ;
