Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUMFXH

XUMFXH.m

Go to the documentation of this file.
  1. XUMFXH ;ISS/RAM - MFS Handler ;06/28/00
  1. ;;8.0;KERNEL;**299,382,383**;Jul 10, 1995
  1. ;
  1. ; This routine handles Master File HL7 messages.
  1. ;
  1. MAIN ; -- entry point
  1. ;
  1. N CNT,ERR,I,X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,MTPE,TYPE,ARRAY
  1. N HDT,KEY,MID,REASON,VALUE,XREF,ALL,GROUP,PARAM,ROOT,SEG,QRD,XUMF
  1. N QID,WHAT,WHO,HLSCS,CDSYS,EXIT,HLREP,NUMBER,Y,XXX,YYY,ERR,XIEN
  1. N XUMFSDS
  1. ;
  1. D INIT,PROCESS,REPLY^XUMFXACK(ERROR),EXIT
  1. ;
  1. Q
  1. ;
  1. INIT ; -- initialize
  1. ;
  1. K ^TMP("DILIST",$J),^TMP("DIERR",$J)
  1. K ^TMP("HLS",$J),^TMP("HLA",$J)
  1. K ^TMP("XUMF MFS",$J),^TMP("XUMF ERROR",$J)
  1. ;
  1. S XUMF=1,DUZ(0)="@"
  1. ;
  1. S (ERROR,CNT,TYPE,ARRAY,EXIT)=0
  1. S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
  1. S HLSCS=$E(HL("ECH"),4),HLREP=$E(HL("ECH"),2)
  1. ;
  1. Q
  1. ;
  1. PROCESS ; -- pull message text
  1. ;
  1. F X HLNEXT Q:HLQUIT'>0 D
  1. .Q:$P(HLNODE,HLFS)=""
  1. .Q:"^MSH^MSA^QRD^MFI^MFE^RDF^RDT^"'[(U_$P(HLNODE,HLFS)_U)
  1. .D @($P(HLNODE,HLFS))
  1. ;
  1. Q
  1. ;
  1. MSH ; -- MSH segment
  1. ;
  1. Q
  1. ;
  1. MSA ; -- MSA segment
  1. ;
  1. N CODE
  1. ;
  1. S CODE=$P(HLNODE,HLFS,2)
  1. ;
  1. I CODE="AE"!(CODE="AR") D
  1. .S ERROR=ERROR_U_$P(HLNODE,HLFS,4)_U_$G(ERR)
  1. .D EM^XUMFX(ERROR,.ERR)
  1. ;
  1. Q
  1. ;
  1. MFI ; -- MFI segment
  1. ;
  1. Q:ERROR
  1. Q:EXIT
  1. ;
  1. K IFN,ARRAY,MFI
  1. ;
  1. I $P(HLNODE,HLFS,2)="" D Q
  1. .S ERROR="1^MFI segment missing Master File Identifier HLNODE: "_HLNODE
  1. .D EM^XUMFX(ERROR,.ERR)
  1. ;
  1. S MFI=$P(HLNODE,HLFS,2),IFN=MFI
  1. S:'IFN IFN=$O(^DIC(4.001,"MFI",$P(MFI,HLCS,2),0))
  1. S IFN=$S(IFN:IFN,MFI="ZMF":4.001,1:0)
  1. I 'IFN D Q
  1. .S ERROR="1^IFN in MFI could not be resolved HLNODE: "_HLNODE
  1. .D EM^XUMFX(ERROR,.ERR)
  1. ;
  1. ;sds flag=1; 1H is history record (use alt key for owning record)
  1. S XUMFSDS=$S($P(MFI,HLCS,3)="SDS":1,1:0)
  1. I XUMFSDS,MFI["History" S XUMFSDS="1H"
  1. ;
  1. S ARRAY=$S($G(ARRAY):1,$P(HLNODE,HLFS,3)="TEMP":1,1:0)
  1. ;
  1. Q
  1. ;
  1. MFE ; -- MFE segment
  1. ;
  1. Q:ERROR
  1. Q:EXIT
  1. ;
  1. K IEN
  1. ;
  1. N PRE,POST
  1. ;
  1. S KEY=$P(HLNODE,HLFS,5) Q:ARRAY
  1. ;
  1. S PRE=$P($G(^DIC(4.001,+IFN,"MFE")),U,16)
  1. I PRE'="" D Q:$G(EXIT)
  1. .S PRE=PRE_"^XUMFXR"
  1. .D @(PRE)
  1. ;
  1. D MFE^XUMFX(IFN,KEY,HLCS,.IEN,.ERROR) Q:ERROR
  1. ;
  1. S POST=$P($G(^DIC(4.001,+IFN,"MFE")),U,17)
  1. I POST'="" D Q:$G(EXIT)
  1. .S POST=POST_"^XUMFXR"
  1. .D @(POST)
  1. ;
  1. I 'IEN D Q
  1. .S ERROR="1^IEN not resolved in MFE File #: "_IFN_" HLNODE: "_HLNODE
  1. .D EM^XUMFX(ERROR,.ERR)
  1. .K ERR
  1. ;
  1. ; clean multiple flag
  1. K:'$D(XIEN(IEN)) XIEN
  1. S XIEN(IEN)=$G(XIEN(IEN))+1
  1. ;
  1. Q
  1. ;
  1. RDF ; -- table row definition
  1. ;
  1. Q:ERROR
  1. Q:EXIT
  1. ;
  1. I $G(ARRAY) D ARRAY Q
  1. ;
  1. N COL,X,Y,Z,DTYP,IDX,SEQ,VUID,DATA,NAME
  1. ;
  1. K ^TMP("XUMF MFS",$J,"PARAM","SEQ")
  1. K ^TMP("XUMF MFS",$J,"PARAM","MULT")
  1. K ^TMP("XUMF MFS",$J,"PARAM","IENS")
  1. ;
  1. K XXX,YYY
  1. ;
  1. D SEGPRSE^XUMFXHL7("HLNODE","XXX")
  1. S NUMBER=XXX(1)
  1. D SEQPRSE^XUMFXHL7("XXX(2)","COL") K XXX
  1. I $O(COL(99999),-1)'=NUMBER D Q
  1. .S ERROR="1^RDF number of columns error"
  1. .D EM^XUMFX("RDF segment columns don't match number",.ERROR)
  1. ;
  1. ;S NUMBER=$P(HLNODE,HLFS,2)
  1. ;S DATA=$P(HLNODE,HLFS,3)
  1. ;
  1. ;S CNT=0,Y=0
  1. ;F SEQ=1:1:NUMBER D
  1. ;.S Y=Y+1
  1. ;.S Z=$P(DATA,HLREP,Y)
  1. ;.I Y=$L(DATA,HLREP) D
  1. ;..S CNT=$O(HLNODE(CNT))
  1. ;..S DATA=$G(HLNODE(+CNT))
  1. ;..S Z=Z_$P(DATA,HLREP)
  1. ;..S Y=1
  1. ;.S COL(SEQ)=Z
  1. ;
  1. S SEQ=0
  1. F S SEQ=$O(COL(SEQ)) Q:'SEQ D
  1. .S NAME=COL(SEQ,1),TYP=COL(SEQ,2) Q:NAME=""
  1. .;S NAME=$P(COL(SEQ),HLCS) Q:NAME=""
  1. .S IDX=$O(^DIC(4.001,+IFN,1,"B",NAME,0)) Q:'IDX
  1. .S DATA=$G(^DIC(4.001,+IFN,1,+IDX,0)) Q:DATA=""
  1. .S YYY(NAME,SEQ)=""
  1. .;
  1. .;N FLD,TYP,SUBFILE,LKUP,REPEAT,CLEAN,TIMEZONE
  1. .;S TYP=$P(DATA,U,3),TYP=$$GET1^DIQ(771.4,(+TYP_","),.01)
  1. .N FLD,SUBFILE,LKUP,REPEAT,CLEAN,TIMEZONE
  1. .S FLD=$P(DATA,U,2),SUBFILE=$P(DATA,U,4)
  1. .S LKUP=$P(DATA,U,7),TIMEZONE=$P(DATA,U,14)
  1. .S REPEAT=$P(DATA,U,11),CLEAN=$P(DATA,U,12),VUID=$P(DATA,U,13)
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"VUID")=VUID
  1. .;
  1. .I 'SUBFILE D Q
  1. ..S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,FLD)=TYP_U_LKUP
  1. .;
  1. .; -- multiple field
  1. .;
  1. .I $P(DATA,U,6)'="" D ;.01 is a field
  1. ..S XXX(SEQ)=$P(DATA,U,6)
  1. .;
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FILE")=SUBFILE
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FIELD")=FLD
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"DTYP")=TYP
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"REPEAT")=REPEAT
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"CLEAN")=CLEAN
  1. .S ^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"TIMEZONE")=TIMEZONE
  1. ;
  1. S SEQ=0
  1. F S SEQ=$O(XXX(SEQ)) Q:'SEQ D
  1. .S X=XXX(SEQ),Y=$O(YYY(X,0))
  1. .S ^TMP("XUMF MFS",$J,"PARAM","MULT",SEQ)=Y
  1. ;
  1. Q
  1. ;
  1. RDT ; -- table row data
  1. ;
  1. Q:ERROR
  1. Q:EXIT
  1. ;
  1. K XXX
  1. D SEGPRSE^XUMFXHL7("HLNODE","XXX")
  1. I $O(XXX(99999),-1)'=NUMBER D Q
  1. .S ERROR="1^RDF/RDT number of columns error"
  1. .D EM^XUMFX("RDF/RDT segment columns don't match number",.ERROR)
  1. ;
  1. I $G(ARRAY) D ARRAY Q
  1. ;
  1. Q:'IEN
  1. ;
  1. N FDA,IENS,FIELD,ERR,PRE,POST,MULT,FDA1,SEQ,VUID,TIMEZONE
  1. ;
  1. S PRE=$P($G(^DIC(4.001,+IFN,0)),U,4)
  1. I PRE'="" D
  1. .S PRE=PRE_"^XUMFR"
  1. .D @(PRE)
  1. ;
  1. S IENS=IEN_","
  1. S SEQ=0
  1. F S SEQ=$O(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ)) Q:'SEQ D
  1. .S FIELD=$O(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,0))
  1. .S VUID=$G(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"VUID"))
  1. .S TIMEZONE=$G(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"TIMEZONE"))
  1. .I 'FIELD D SUBFILE Q
  1. .S TYP=$G(^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,FIELD))
  1. .S VALUE=$$VALUE()
  1. .S VALUE=$$DTYP^XUMFXP(VALUE,TYP,HLCS,0,TIMEZONE)
  1. .S VALUE=$$VAL^XUMFX(IFN,FIELD,VUID,VALUE,IENS) Q:VALUE="^"
  1. .S FDA(IFN,IENS,FIELD)=VALUE
  1. ;
  1. M FDA=FDA1
  1. ;
  1. D:$D(FDA) FILE^DIE(,"FDA","ERR")
  1. I $D(ERR) D
  1. .S ERROR="1^updating error"
  1. .D EM^XUMFX("file DIE call error message in RDT",.ERR)
  1. .K ERR
  1. ;
  1. S POST=$P($G(^DIC(4.001,+IFN,0)),U,5)
  1. I POST'="" D
  1. .S POST=POST_"^XUMFR"
  1. .D @(POST)
  1. ;
  1. Q
  1. ;
  1. SUBFILE ; -- process subfile record
  1. ;
  1. N IFN,IENS1,KEY1,FIELD,TYP,MKEY,ERR,REPEAT,CLEAN
  1. ;
  1. S IFN=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FILE")
  1. S FIELD=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"FIELD")
  1. S TYP=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"DTYP")
  1. S REPEAT=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"REPEAT")
  1. S CLEAN=^TMP("XUMF MFS",$J,"PARAM","SEQ",SEQ,"CLEAN")
  1. ;
  1. I CLEAN,$G(XIEN(IEN))'>1 D
  1. .N ROOT,IDX
  1. .S ROOT=$$ROOT^DILFD(IFN,","_IENS,1)
  1. .S IDX=0 F S IDX=$O(@ROOT@(IDX)) Q:'IDX D
  1. ..D
  1. ...N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
  1. ;
  1. S VALUE=$$VALUE()
  1. S VALUE=$$DTYP^XUMFXP(VALUE,TYP,HLCS,0,TIMEZONE)
  1. ;
  1. S MULT=$G(^TMP("XUMF MFS",$J,"PARAM","MULT",SEQ))
  1. ;
  1. I MULT=SEQ Q:VALUE="" D
  1. .N FDA,IEN
  1. .S VALUE=$$VAL^XUMFX(IFN,FIELD,VUID,VALUE,"?+1,"_IENS) Q:VALUE="^"
  1. .S FDA(IFN,"?+1,"_IENS,.01)=VALUE
  1. .D UPDATE^DIE(,"FDA","IEN","ERR")
  1. .I $D(ERR) D Q
  1. ..S ERROR="1^subfile update error SUBFILE#: "_IFN
  1. ..D EM^XUMFX("update DIE call error message in SUBFILE",.ERR)
  1. ..K ERR
  1. .S IENS1=IEN(1)_","_IENS,MULT(SEQ)=IENS1
  1. ;
  1. I MULT,MULT'=SEQ S IENS1=$G(MULT(+MULT)) Q:IENS1=""
  1. S:MULT'=SEQ VALUE=$$VAL^XUMFX(IFN,FIELD,VUID,VALUE,"?+1,"_IENS) Q:VALUE="^"
  1. S:$D(IENS1) FDA1(IFN,IENS1,FIELD)=VALUE
  1. ;
  1. Q
  1. ;
  1. VALUE() ; -- handle HL7 continuation nodes
  1. ;
  1. Q:'$O(HLNODE(0)) $P(HLNODE,HLFS,SEQ+1)
  1. ;
  1. N COL
  1. ;
  1. D SEGPRSE^XUMFXHL7("HLNODE","COL")
  1. ;
  1. Q COL(SEQ)
  1. ;
  1. ARRAY ; -- query data stored in array (not filed)
  1. ;
  1. N X S X=KEY S X=$S($P(X,HLCS)'="":$P(X,HLCS),1:$P(X,HLCS,4)) Q:X=""
  1. ;
  1. M ^TMP("XUMF ARRAY",$J,IFN,X)=HLNODE
  1. ;
  1. Q
  1. ;
  1. EXIT ; -- cleanup, and quit
  1. ;
  1. ; post processing logic
  1. S X=$G(^DIC(4.001,+IFN,2)) X:X'="" X
  1. ;
  1. K ^TMP("DILIST",$J),^TMP("DIERR",$J),^TMP("HLS",$J),^TMP("HLA",$J)
  1. ;
  1. K ^TMP("XUMF MFS",$J),^TMP("XUMF ERROR",$J)
  1. ;
  1. Q
  1. ;