- XUMF1H ;ISS/RAM - MFS Handler ;6/27/06 07:50
- ;;8.0;KERNEL;**407,474**;Jul 10, 1995;Build 12
- ;Per VHA Directive 10-92-142, this routine should not be modified
- ;
- ; This routine handles Master File HL7 messages.
- ;
- MAIN ; -- entry point
- ;
- N CNT,ERR,I,X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,MTPE,TYPE,ARRAY
- N HDT,KEY,MID,REASON,VALUE,XREF,ALL,GROUP,PARAM,ROOT,SEG,QRD,XUMF
- N QID,WHAT,WHO,HLSCS,CDSYS,EXIT,HLREP,NUMBER,Y,XXX,YYY,XIEN
- N XUMFSDS,FDA,LIST,ERRCNT,PKV,MKEY,MKEY1,TYP,MFI,IMPLY,RECORD,OUT
- ;
- D INIT,PROCESS,REPLY,EXIT
- ;
- Q
- ;
- INIT ; -- initialize
- ;
- K ^TMP("DILIST",$J),^TMP("DIERR",$J)
- K ^TMP("HLS",$J),^TMP("HLA",$J)
- K ^TMP("XUMF MFS",$J),^TMP("XUMF ERROR",$J)
- K ^TMP("XUMF EVENT",$J)
- ;
- S XUMF=1,DUZ(0)="@"
- ;
- S (ERROR,CNT,TYPE,ARRAY,EXIT,ERRCNT)=0
- S HLFS=HL("FS"),HLCS=$E(HL("ECH"))
- S HLSCS=$E(HL("ECH"),4),HLREP=$E(HL("ECH"),2)
- ;
- Q
- ;
- PROCESS ; -- pull message text
- ;
- F X HLNEXT Q:HLQUIT'>0 D
- .Q:$P(HLNODE,HLFS)=""
- .Q:"^MSH^MSA^QRD^MFI^MFE^ZRT^"'[(U_$P(HLNODE,HLFS)_U)
- .D @($P(HLNODE,HLFS))
- I $D(LIST) D LIST
- I $D(FDA) D UPDATE
- I $D(RECORD) D RECORD
- I $D(IFN) D EVT^XUMF0,POST
- ;
- 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^XUMFX(ERROR,.ERR)
- ;
- Q
- ;
- MFI ; -- MFI segment
- ;
- Q:ERROR
- Q:EXIT
- ;
- Q
- ;
- MFE ; -- MFE SEGMENT
- ;
- Q:ERROR
- Q:EXIT
- ;
- S PKV=$P(HLNODE,HLFS,5),MFI=$P(PKV,"@")
- ;
- I $D(LIST) D LIST K LIST,LISTVUID
- I $D(FDA) D UPDATE K FDA
- I $D(RECORD) D RECORD
- I $D(IFN),(IFN'=$O(^DIC(4.001,"MFID",MFI,0))) D POST
- ;
- K IFN,IEN,PRE,POST,VUID,IMPLY,RECORD
- K ^TMP("XUMF IMPLIED LOGIC",$J)
- ;
- I MFI="" S ERROR="1^MFI not resolved HLNODE: "_HLNODE Q
- S IFN=$O(^DIC(4.001,"MFID",MFI,0))
- I 'IFN S ERROR="1^IFN not resolved HLNODE: "_HLNODE Q
- ;
- S VUID=$P($P(PKV,"@",2),HLCS)
- ;
- Q:ARRAY
- ;
- ;MFE processing
- D MFE0 Q:ERROR
- ;
- D:'$G(IEN) MFE^XUMF0(IFN,VUID,.IEN,.ERROR) Q:ERROR
- ;
- ;D MFE0
- ;
- ;Implied logic flag - must be set by MFE-Processing Logic field (#4)
- S IMPLY=+$G(^TMP("XUMF IMPLIED LOGIC",$J))
- S IMPLY("KILL")=0
- K ^TMP("XUMF IMPLIED LOGIC",$J)
- ;
- I IEN D
- .; clean multiple flag
- .K:'$D(XIEN(IFN,IEN)) XIEN
- .S XIEN(IFN,IEN)=$G(XIEN(IFN,IEN))+1
- .;
- .N ROOT
- .S ROOT=$$ROOT^DILFD(IFN,,1)
- .M RECORD("BEFORE")=@ROOT@(IEN)
- .S RECORD("STATUS")=$$GETSTAT^XTID(IFN,,IEN_",")
- .;
- .S ^TMP("XUMF EVENT",$J,IFN,"BEFORE",IEN,"REPLACED BY")=$P($G(@ROOT@(IEN,"VUID")),U,3)
- .S ^TMP("XUMF EVENT",$J,IFN,"BEFORE",IEN,"INHERITS FROM")=$$RPLCMNT^XTIDTRM(IFN,IEN)
- ;
- Q
- ;
- ZRT ; -- data segments
- ;
- Q:ERROR
- Q:EXIT
- ;
- I $G(ARRAY) D ARRAY Q
- ;
- N COL,X,Y,Z,DTYP,IDX,SEQ,DATA,NAME,VUID1,LIST1
- N FIELD,SUBFILE,LKUP,REPEAT,CLEAN,TIMEZONE,WP
- ;
- S NAME=$P(HLNODE,HLFS,2)
- ;
- D ZRT0 Q:ERROR I $G(OUT) K OUT Q
- ;
- I 'IEN,NAME="Term" D STUB^XUMF0 Q
- I 'IEN S ERROR="1^IEN not defined IFN: "_IFN_" VUID: "_VUID Q
- ;
- ;D ZRT0 Q:ERROR
- ;
- S IENS=IEN_","
- ;
- S IDX=$O(^DIC(4.001,+IFN,1,"B",NAME,0))
- I 'IDX S ERROR="1^parameter "_NAME_" not defined IFN: "_IFN Q
- S DATA=$G(^DIC(4.001,+IFN,1,+IDX,0))
- S TYP=$P(DATA,U,3),TYP=$$GET1^DIQ(771.4,(+TYP_","),.01)
- S FIELD=$P(DATA,U,2),SUBFILE=$P(DATA,U,4),MKEY=$P(DATA,U,6)
- S LKUP=$P(DATA,U,7),TIMEZONE=$P(DATA,U,14),LIST1=$P(DATA,U,8)
- S REPEAT=$P(DATA,U,11),CLEAN=$P(DATA,U,12),VUID1=$P(DATA,U,13)
- S WP=$P(DATA,U,16)
- ;
- I WP D WP Q
- ;
- S VALUE=$$UNESC^XUMF0($P(HLNODE,HLFS,3),.HL)
- S VALUE=$$DTYP^XUMFXP(VALUE,TYP,HLCS,0,TIMEZONE)
- ;
- I NAME="Status" D STATUS Q
- ;
- I 'SUBFILE D Q
- .S VALUE=$$VAL^XUMF0(IFN,FIELD,VUID1,VALUE,IENS) Q:VALUE="^"
- .S FDA(IFN,IENS,FIELD)=VALUE
- ;
- N IENS1
- ;
- I LIST1 D Q
- .S VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS) Q:VALUE="^"
- .I MKEY=NAME S ZKEY=VALUE ;S:VUID1'="" LISTVUID(SUBFILE)=1
- .I '$D(ZKEY) S ERROR="1^ZKEY error "_SUBFILE_" VUID: "_VUID Q
- .I ((ZKEY="")!(ZKEY=$C(34,34))) S LIST(SUBFILE)="" Q
- .S LIST(SUBFILE,ZKEY,FIELD)=VALUE
- .I IMPLY D IMPLY
- ;
- I CLEAN,$G(XIEN(IFN,IEN))'>1 D
- .N ROOT,IDX
- .S ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- .S IDX=0 F S IDX=$O(@ROOT@(IDX)) Q:'IDX D
- ..D
- ...N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
- ;
- I MKEY=NAME Q:VALUE="" D
- .N FDA,IEN
- .;
- .S VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS) Q:VALUE="^"
- .S FDA(SUBFILE,"?+1,"_IENS,.01)=VALUE
- .D UPDATE^DIE(,"FDA","IEN","ERR")
- .I $D(ERR) D Q
- ..S ERROR="1^subfile update error SUBFILE#: "_SUBFILE
- ..D EM(ERROR,.ERR) K ERR
- .S IENS1=IEN(1)_","_IENS,MKEY(NAME)=IENS1
- ;
- I MKEY'="",MKEY'=NAME S IENS1=$G(MKEY(MKEY)) Q:IENS1=""
- S:MKEY'=NAME VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS) Q:VALUE="^"
- S:$D(IENS1) FDA(SUBFILE,IENS1,FIELD)=VALUE
- I IMPLY D IMPLY
- ;
- Q
- ;
- IMPLY ; -- Implied value logic
- N PREV,ARR
- S ARR=$S(LIST1:"LIST",1:"FDA")
- S PREV=$S(LIST1:ZKEY,1:IENS1)
- I MKEY=NAME D Q
- .I IMPLY("KILL") K IMPLY("PREV") S IMPLY("KILL")=0
- .S IMPLY("PREV",PREV)=""
- S PREV="" F S PREV=$O(IMPLY("PREV",PREV)) Q:PREV="" D
- .S @ARR@(SUBFILE,PREV,FIELD)=VALUE
- S IMPLY("KILL")=1
- Q
- ;
- LIST ; -- process list
- ;
- N SUBFILE,ZKEY,FIELD,VALUE,IENS,CNT
- ;
- S IENS=IEN_","
- ;
- ;remove non-standard sub-records (not in message)
- S SUBFILE=0
- F S SUBFILE=$O(LIST(SUBFILE)) Q:'SUBFILE D
- .N ROOT,IDX
- .S ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- .S IDX=0 F S IDX=$O(@ROOT@(IDX)) Q:'IDX D
- ..S VALUE=$$GET1^DIQ(SUBFILE,IDX_","_IENS,.01,"I")
- ..I '$D(LIST(SUBFILE,VALUE)) D
- ...N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
- ;
- ;update sub-records
- S SUBFILE=0
- F S SUBFILE=$O(LIST(SUBFILE)) Q:'SUBFILE D
- .S ZKEY="",CNT=0
- .F S ZKEY=$O(LIST(SUBFILE,ZKEY)) Q:ZKEY="" D
- ..N IDX,ROOT
- ..S ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- ..S IDX=$O(@ROOT@("B",ZKEY,0))
- ..I $O(@ROOT@("B",ZKEY,IDX)) D DELLIST(IDX)
- ..I 'IDX D ADDLIST Q
- ..S FIELD=0
- ..F S FIELD=$O(LIST(SUBFILE,ZKEY,FIELD)) Q:'FIELD D
- ...N X S X=$$GET1^DIQ(SUBFILE,IDX_","_IENS,FIELD)
- ...S VALUE=LIST(SUBFILE,ZKEY,FIELD)
- ...Q:VALUE=X Q:(VALUE=""""&X="")
- ...S FDA(SUBFILE,IDX_","_IENS,FIELD)=VALUE
- ;
- Q
- ;
- ADDLIST ; -- add new sub-record
- ;
- N FDA
- ;
- S CNT=$G(CNT)+1
- S FIELD=0
- F S FIELD=$O(LIST(SUBFILE,ZKEY,FIELD)) Q:'FIELD D
- .S VALUE=LIST(SUBFILE,ZKEY,FIELD) Q:VALUE=""
- .S FDA(SUBFILE,"+"_CNT_","_IENS,FIELD)=VALUE
- ;
- Q:'$D(FDA)
- ;
- D UPDATE^DIE(,"FDA",,"ERR")
- I $D(ERR) D Q
- .S ERROR="1^subfile update error SUBFILE#: "_SUBFILE
- .D EM(ERROR,.ERR) K ERR
- ;
- Q
- ;
- DELLIST(IDX) ; -- delete duplicate
- ;
- F S IDX=$O(@ROOT@("B",ZKEY,IDX)) Q:'IDX D
- .N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
- ;
- Q
- ;
- UPDATE ; -- FileMan update
- ;
- Q:ERROR
- Q:EXIT
- ;
- D:$D(FDA) FILE^DIE(,"FDA","ERR")
- I $D(ERR) D
- .S ERROR="1^updating error"
- .D EM(ERROR,.ERR) K ERR
- ;
- Q
- ;
- ARRAY ; -- query data stored in array (not filed)
- ;
- S ^TMP("XUMF ARRAY",$J,IFN,VUID,$P(HLNODE,HLFS,2))=$P(HLNODE,HLFS,3)
- ;
- Q
- ;
- ADD ; -- ADD-processing logic
- ;
- N X
- ;
- S X=$G(^DIC(4.001,+IFN,3)) X:X'="" X
- ;
- Q
- ;
- MFE0 ; -- MFE-processing logic
- ;if creating a new entry you must set IEN and other tasks performed in STUB^XUMF0 (if appropriate)
- ;
- N X
- ;
- S X=$G(^DIC(4.001,+IFN,4)) X:X'="" X
- ;
- Q
- ;
- ZRT0 ; -- ZRT-processing logic
- ;
- N X
- ;
- S X=$G(^DIC(4.001,+IFN,5)) X:X'="" X
- ;
- Q
- ;
- POST ; -- post-processing logic
- ;
- N X
- ;
- S X=$G(^DIC(4.001,+IFN,2)) X:X'="" X
- ;
- Q
- ;
- EXIT ; -- cleanup, and quit
- ;
- K ^TMP("DILIST",$J),^TMP("DIERR",$J),^TMP("HLS",$J),^TMP("HLA",$J)
- ;
- K ^TMP("XUMF MFS",$J),^TMP("XUMF ERROR",$J),^TMP("XUMF EVENT",$J)
- ;
- Q
- ;
- REPLY ; -- MFK
- ;
- N X,I,I1,I2,CNT
- ;
- S CNT=1
- S X="MSA"_HLFS_$S(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$P(ERROR,U,2)
- S ^TMP("HLA",$J,CNT)=X
- S CNT=CNT+1
- ;
- S I1="",I=0
- F S I1=$O(^TMP("XUMF ERROR",$J,I1)) Q:'$L(I1) D
- .S I2="" F S I2=$O(^TMP("XUMF ERROR",$J,I1,I2)) Q:'$L(I2) D
- ..S X=$G(^(I2))
- ..Q:'$L(X)
- ..S I=I+1
- ..S X="ERR"_HLFS_I_HLFS_$S($O(^TMP("XUMF ERROR",$J,I1))!$O(^TMP("XUMF ERROR",$J,I1,I2)):1,1:0)_HLFS_X
- ..S ^TMP("HLA",$J,CNT)=X
- ..S CNT=CNT+1
- ;
- D:ERROR EM^XUMF0
- ;
- D GENACK^HLMA1($G(HL("EID")),$G(HLMTIENS),$G(HL("EIDS")),"GM",1,.HLRESLT)
- ;
- Q
- ;
- EM(ERROR,ERR) ; -- error message
- ;
- N X,I,Y
- ;
- D MSG^DIALOG("AM",.X,80,,"ERR")
- ;
- S ERRCNT=ERRCNT+1
- ;
- S ^TMP("XUMF ERROR",$J,ERRCNT_".01")=""
- S ^TMP("XUMF ERROR",$J,ERRCNT_".02")=""
- S ^TMP("XUMF ERROR",$J,ERRCNT_".03")=$G(ERROR)
- S ^TMP("XUMF ERROR",$J,ERRCNT_".04")=""
- S ^TMP("XUMF ERROR",$J,ERRCNT_".05")="VUID: "_$G(VUID)_" IFN: "_$G(IFN)_" IEN: "_IEN
- S ^TMP("XUMF ERROR",$J,ERRCNT_".06")=""
- S X=.9 F S X=$O(X(X)) Q:'X D
- .S ^TMP("XUMF ERROR",$J,ERRCNT_"."_X)=X(X)
- ;
- Q
- ;
- STATUS ;
- ;
- I VALUE=$P($$GETSTAT^XTID(IFN,,IEN_","),U) Q
- ;
- I SUBFILE="" S ERROR="1^status parameter error" Q
- ;
- N FDA
- S FDA(SUBFILE,"?+1,"_IENS,.01)=$$NOW^XLFDT
- S FDA(SUBFILE,"?+1,"_IENS,.02)=VALUE
- D UPDATE^DIE(,"FDA",,"ERR")
- I $D(ERR) D
- .S ERROR="1^effective date and status error"
- .D EM(ERROR,.ERR) K ERR
- ;
- Q
- ;
- WP ;
- ;
- N X,Y,A,I,CNT,X1,X2,ESC
- D SEGPRSE^XUMFXHL7("HLNODE","X",HLFS,60)
- ;
- S CNT=1
- S A(CNT)=X(2)
- S I=0
- F S I=$O(X(2,I)) Q:'I D
- .S Y=X(2,I)
- .I $E(Y,1)=" " D Q
- ..S A(CNT)=A(CNT)_" "
- ..Q:$P(Y," ",2)=""
- ..S CNT=CNT+1
- ..S A(CNT)=$P(Y," ",2,99)
- .S X1=$P(Y," ",1)
- .S X2=$P(Y," ",2,99)
- .S A(CNT)=A(CNT)_X1_$S(X2="":"",1:" ")
- .Q:X2=""
- .S CNT=CNT+1
- .S A(CNT)=X2
- ;
- D UNESCWP^XUMF0(.A,.HL)
- ;
- D WP^DIE(IFN,IENS,FIELD,"K","A","ERR")
- ;
- I $D(ERR) D
- .S ERROR="1^wp field error"
- .D EM(ERROR,.ERR) K ERR
- ;
- Q
- ;
- RECORD ;MFS event protocol data
- ;
- N ROOT,NODE,NODE1,CHANGE,STATUS
- ;
- I $G(ERROR) D Q
- .S ^TMP("XUMF EVENT",$J,"ERROR")=ERROR
- .S ^TMP("XUMF EVENT",$J,"ERROR",1)=$G(IFN)_U_$G(IEN)
- ;
- S ROOT=$$ROOT^DILFD(IFN,,1)
- M RECORD("AFTER")=@ROOT@(IEN)
- ;
- I $G(RECORD("NEW")) M ^TMP("XUMF EVENT",$J,IFN,"NEW",IEN)=RECORD("AFTER") Q
- ;
- S ^TMP("XUMF EVENT",$J,IFN,"AFTER",IEN,"REPLACED BY")=$P($G(@ROOT@(IEN,"VUID")),U,3)
- S ^TMP("XUMF EVENT",$J,IFN,"AFTER",IEN,"INHERITS FROM")=$$RPLCMNT^XTIDTRM(IFN,IEN)
- ;
- S STATUS=$$GETSTAT^XTID(IFN,,IEN_",")
- I RECORD("STATUS")'=STATUS D
- .S ^TMP("XUMF EVENT",$J,IFN,"STATUS",IEN)=$P(RECORD("STATUS"),U,1,2)_U_$P(STATUS,U,1,2)
- ;
- S NODE=$Q(RECORD("AFTER","")),NODE1=$Q(RECORD("BEFORE","")),CHANGE=0
- I $P(NODE,"RECORD(""AFTER")'=$P(NODE1,"RECORD(""BEFORE") S CHANGE=1
- I @NODE'=@NODE1 S CHANGE=1
- I 'CHANGE FOR SET NODE=$Q(@NODE) Q:NODE=""!(NODE["(""BEFORE") D Q:CHANGE
- .S NODE1=$Q(@NODE1) I NODE1="" S CHANGE=1 Q
- .I $P(NODE,"RECORD(""AFTER")'=$P(NODE1,"RECORD(""BEFORE") S CHANGE=1 Q
- .I @NODE'=@NODE1 S CHANGE=1 Q
- ;
- I CHANGE D
- .M ^TMP("XUMF EVENT",$J,IFN,"AFTER",IEN)=RECORD("AFTER")
- .M ^TMP("XUMF EVENT",$J,IFN,"BEFORE",IEN)=RECORD("BEFORE")
- ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF1H 11023 printed Mar 13, 2025@21:15:04 Page 2
- XUMF1H ;ISS/RAM - MFS Handler ;6/27/06 07:50
- +1 ;;8.0;KERNEL;**407,474**;Jul 10, 1995;Build 12
- +2 ;Per VHA Directive 10-92-142, this routine should not be modified
- +3 ;
- +4 ; This routine handles Master File HL7 messages.
- +5 ;
- MAIN ; -- entry point
- +1 ;
- +2 NEW CNT,ERR,I,X,HLFS,HLCS,ERROR,HLRESLTA,IFN,IEN,MTPE,TYPE,ARRAY
- +3 NEW HDT,KEY,MID,REASON,VALUE,XREF,ALL,GROUP,PARAM,ROOT,SEG,QRD,XUMF
- +4 NEW QID,WHAT,WHO,HLSCS,CDSYS,EXIT,HLREP,NUMBER,Y,XXX,YYY,XIEN
- +5 NEW XUMFSDS,FDA,LIST,ERRCNT,PKV,MKEY,MKEY1,TYP,MFI,IMPLY,RECORD,OUT
- +6 ;
- +7 DO INIT
- DO PROCESS
- DO REPLY
- DO EXIT
- +8 ;
- +9 QUIT
- +10 ;
- INIT ; -- initialize
- +1 ;
- +2 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
- +3 KILL ^TMP("HLS",$JOB),^TMP("HLA",$JOB)
- +4 KILL ^TMP("XUMF MFS",$JOB),^TMP("XUMF ERROR",$JOB)
- +5 KILL ^TMP("XUMF EVENT",$JOB)
- +6 ;
- +7 SET XUMF=1
- SET DUZ(0)="@"
- +8 ;
- +9 SET (ERROR,CNT,TYPE,ARRAY,EXIT,ERRCNT)=0
- +10 SET HLFS=HL("FS")
- SET HLCS=$EXTRACT(HL("ECH"))
- +11 SET HLSCS=$EXTRACT(HL("ECH"),4)
- SET HLREP=$EXTRACT(HL("ECH"),2)
- +12 ;
- +13 QUIT
- +14 ;
- PROCESS ; -- pull message text
- +1 ;
- +2 FOR
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- Begin DoDot:1
- +3 if $PIECE(HLNODE,HLFS)=""
- QUIT
- +4 if "^MSH^MSA^QRD^MFI^MFE^ZRT^"'[(U_$PIECE(HLNODE,HLFS)_U)
- QUIT
- +5 DO @($PIECE(HLNODE,HLFS))
- End DoDot:1
- +6 IF $DATA(LIST)
- DO LIST
- +7 IF $DATA(FDA)
- DO UPDATE
- +8 IF $DATA(RECORD)
- DO RECORD
- +9 IF $DATA(IFN)
- DO EVT^XUMF0
- DO POST
- +10 ;
- +11 QUIT
- +12 ;
- 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^XUMFX(ERROR,.ERR)
- End DoDot:1
- +9 ;
- +10 QUIT
- +11 ;
- MFI ; -- MFI segment
- +1 ;
- +2 if ERROR
- QUIT
- +3 if EXIT
- QUIT
- +4 ;
- +5 QUIT
- +6 ;
- MFE ; -- MFE SEGMENT
- +1 ;
- +2 if ERROR
- QUIT
- +3 if EXIT
- QUIT
- +4 ;
- +5 SET PKV=$PIECE(HLNODE,HLFS,5)
- SET MFI=$PIECE(PKV,"@")
- +6 ;
- +7 IF $DATA(LIST)
- DO LIST
- KILL LIST,LISTVUID
- +8 IF $DATA(FDA)
- DO UPDATE
- KILL FDA
- +9 IF $DATA(RECORD)
- DO RECORD
- +10 IF $DATA(IFN)
- IF (IFN'=$ORDER(^DIC(4.001,"MFID",MFI,0)))
- DO POST
- +11 ;
- +12 KILL IFN,IEN,PRE,POST,VUID,IMPLY,RECORD
- +13 KILL ^TMP("XUMF IMPLIED LOGIC",$JOB)
- +14 ;
- +15 IF MFI=""
- SET ERROR="1^MFI not resolved HLNODE: "_HLNODE
- QUIT
- +16 SET IFN=$ORDER(^DIC(4.001,"MFID",MFI,0))
- +17 IF 'IFN
- SET ERROR="1^IFN not resolved HLNODE: "_HLNODE
- QUIT
- +18 ;
- +19 SET VUID=$PIECE($PIECE(PKV,"@",2),HLCS)
- +20 ;
- +21 if ARRAY
- QUIT
- +22 ;
- +23 ;MFE processing
- +24 DO MFE0
- if ERROR
- QUIT
- +25 ;
- +26 if '$GET(IEN)
- DO MFE^XUMF0(IFN,VUID,.IEN,.ERROR)
- if ERROR
- QUIT
- +27 ;
- +28 ;D MFE0
- +29 ;
- +30 ;Implied logic flag - must be set by MFE-Processing Logic field (#4)
- +31 SET IMPLY=+$GET(^TMP("XUMF IMPLIED LOGIC",$JOB))
- +32 SET IMPLY("KILL")=0
- +33 KILL ^TMP("XUMF IMPLIED LOGIC",$JOB)
- +34 ;
- +35 IF IEN
- Begin DoDot:1
- +36 ; clean multiple flag
- +37 if '$DATA(XIEN(IFN,IEN))
- KILL XIEN
- +38 SET XIEN(IFN,IEN)=$GET(XIEN(IFN,IEN))+1
- +39 ;
- +40 NEW ROOT
- +41 SET ROOT=$$ROOT^DILFD(IFN,,1)
- +42 MERGE RECORD("BEFORE")=@ROOT@(IEN)
- +43 SET RECORD("STATUS")=$$GETSTAT^XTID(IFN,,IEN_",")
- +44 ;
- +45 SET ^TMP("XUMF EVENT",$JOB,IFN,"BEFORE",IEN,"REPLACED BY")=$PIECE($GET(@ROOT@(IEN,"VUID")),U,3)
- +46 SET ^TMP("XUMF EVENT",$JOB,IFN,"BEFORE",IEN,"INHERITS FROM")=$$RPLCMNT^XTIDTRM(IFN,IEN)
- End DoDot:1
- +47 ;
- +48 QUIT
- +49 ;
- ZRT ; -- data segments
- +1 ;
- +2 if ERROR
- QUIT
- +3 if EXIT
- QUIT
- +4 ;
- +5 IF $GET(ARRAY)
- DO ARRAY
- QUIT
- +6 ;
- +7 NEW COL,X,Y,Z,DTYP,IDX,SEQ,DATA,NAME,VUID1,LIST1
- +8 NEW FIELD,SUBFILE,LKUP,REPEAT,CLEAN,TIMEZONE,WP
- +9 ;
- +10 SET NAME=$PIECE(HLNODE,HLFS,2)
- +11 ;
- +12 DO ZRT0
- if ERROR
- QUIT
- IF $GET(OUT)
- KILL OUT
- QUIT
- +13 ;
- +14 IF 'IEN
- IF NAME="Term"
- DO STUB^XUMF0
- QUIT
- +15 IF 'IEN
- SET ERROR="1^IEN not defined IFN: "_IFN_" VUID: "_VUID
- QUIT
- +16 ;
- +17 ;D ZRT0 Q:ERROR
- +18 ;
- +19 SET IENS=IEN_","
- +20 ;
- +21 SET IDX=$ORDER(^DIC(4.001,+IFN,1,"B",NAME,0))
- +22 IF 'IDX
- SET ERROR="1^parameter "_NAME_" not defined IFN: "_IFN
- QUIT
- +23 SET DATA=$GET(^DIC(4.001,+IFN,1,+IDX,0))
- +24 SET TYP=$PIECE(DATA,U,3)
- SET TYP=$$GET1^DIQ(771.4,(+TYP_","),.01)
- +25 SET FIELD=$PIECE(DATA,U,2)
- SET SUBFILE=$PIECE(DATA,U,4)
- SET MKEY=$PIECE(DATA,U,6)
- +26 SET LKUP=$PIECE(DATA,U,7)
- SET TIMEZONE=$PIECE(DATA,U,14)
- SET LIST1=$PIECE(DATA,U,8)
- +27 SET REPEAT=$PIECE(DATA,U,11)
- SET CLEAN=$PIECE(DATA,U,12)
- SET VUID1=$PIECE(DATA,U,13)
- +28 SET WP=$PIECE(DATA,U,16)
- +29 ;
- +30 IF WP
- DO WP
- QUIT
- +31 ;
- +32 SET VALUE=$$UNESC^XUMF0($PIECE(HLNODE,HLFS,3),.HL)
- +33 SET VALUE=$$DTYP^XUMFXP(VALUE,TYP,HLCS,0,TIMEZONE)
- +34 ;
- +35 IF NAME="Status"
- DO STATUS
- QUIT
- +36 ;
- +37 IF 'SUBFILE
- Begin DoDot:1
- +38 SET VALUE=$$VAL^XUMF0(IFN,FIELD,VUID1,VALUE,IENS)
- if VALUE="^"
- QUIT
- +39 SET FDA(IFN,IENS,FIELD)=VALUE
- End DoDot:1
- QUIT
- +40 ;
- +41 NEW IENS1
- +42 ;
- +43 IF LIST1
- Begin DoDot:1
- +44 SET VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS)
- if VALUE="^"
- QUIT
- +45 ;S:VUID1'="" LISTVUID(SUBFILE)=1
- IF MKEY=NAME
- SET ZKEY=VALUE
- +46 IF '$DATA(ZKEY)
- SET ERROR="1^ZKEY error "_SUBFILE_" VUID: "_VUID
- QUIT
- +47 IF ((ZKEY="")!(ZKEY=$CHAR(34,34)))
- SET LIST(SUBFILE)=""
- QUIT
- +48 SET LIST(SUBFILE,ZKEY,FIELD)=VALUE
- +49 IF IMPLY
- DO IMPLY
- End DoDot:1
- QUIT
- +50 ;
- +51 IF CLEAN
- IF $GET(XIEN(IFN,IEN))'>1
- Begin DoDot:1
- +52 NEW ROOT,IDX
- +53 SET ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- +54 SET IDX=0
- FOR
- SET IDX=$ORDER(@ROOT@(IDX))
- if 'IDX
- QUIT
- Begin DoDot:2
- +55 Begin DoDot:3
- +56 NEW DA,DIK,DIC
- SET DA(1)=+IENS
- SET DA=IDX
- SET DIK=$PIECE(ROOT,")")_","
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +57 ;
- +58 IF MKEY=NAME
- if VALUE=""
- QUIT
- Begin DoDot:1
- +59 NEW FDA,IEN
- +60 ;
- +61 SET VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS)
- if VALUE="^"
- QUIT
- +62 SET FDA(SUBFILE,"?+1,"_IENS,.01)=VALUE
- +63 DO UPDATE^DIE(,"FDA","IEN","ERR")
- +64 IF $DATA(ERR)
- Begin DoDot:2
- +65 SET ERROR="1^subfile update error SUBFILE#: "_SUBFILE
- +66 DO EM(ERROR,.ERR)
- KILL ERR
- End DoDot:2
- QUIT
- +67 SET IENS1=IEN(1)_","_IENS
- SET MKEY(NAME)=IENS1
- End DoDot:1
- +68 ;
- +69 IF MKEY'=""
- IF MKEY'=NAME
- SET IENS1=$GET(MKEY(MKEY))
- if IENS1=""
- QUIT
- +70 if MKEY'=NAME
- SET VALUE=$$VAL^XUMF0(SUBFILE,FIELD,VUID1,VALUE,"?+1,"_IENS)
- if VALUE="^"
- QUIT
- +71 if $DATA(IENS1)
- SET FDA(SUBFILE,IENS1,FIELD)=VALUE
- +72 IF IMPLY
- DO IMPLY
- +73 ;
- +74 QUIT
- +75 ;
- IMPLY ; -- Implied value logic
- +1 NEW PREV,ARR
- +2 SET ARR=$SELECT(LIST1:"LIST",1:"FDA")
- +3 SET PREV=$SELECT(LIST1:ZKEY,1:IENS1)
- +4 IF MKEY=NAME
- Begin DoDot:1
- +5 IF IMPLY("KILL")
- KILL IMPLY("PREV")
- SET IMPLY("KILL")=0
- +6 SET IMPLY("PREV",PREV)=""
- End DoDot:1
- QUIT
- +7 SET PREV=""
- FOR
- SET PREV=$ORDER(IMPLY("PREV",PREV))
- if PREV=""
- QUIT
- Begin DoDot:1
- +8 SET @ARR@(SUBFILE,PREV,FIELD)=VALUE
- End DoDot:1
- +9 SET IMPLY("KILL")=1
- +10 QUIT
- +11 ;
- LIST ; -- process list
- +1 ;
- +2 NEW SUBFILE,ZKEY,FIELD,VALUE,IENS,CNT
- +3 ;
- +4 SET IENS=IEN_","
- +5 ;
- +6 ;remove non-standard sub-records (not in message)
- +7 SET SUBFILE=0
- +8 FOR
- SET SUBFILE=$ORDER(LIST(SUBFILE))
- if 'SUBFILE
- QUIT
- Begin DoDot:1
- +9 NEW ROOT,IDX
- +10 SET ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- +11 SET IDX=0
- FOR
- SET IDX=$ORDER(@ROOT@(IDX))
- if 'IDX
- QUIT
- Begin DoDot:2
- +12 SET VALUE=$$GET1^DIQ(SUBFILE,IDX_","_IENS,.01,"I")
- +13 IF '$DATA(LIST(SUBFILE,VALUE))
- Begin DoDot:3
- +14 NEW DA,DIK,DIC
- SET DA(1)=+IENS
- SET DA=IDX
- SET DIK=$PIECE(ROOT,")")_","
- DO ^DIK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 ;
- +16 ;update sub-records
- +17 SET SUBFILE=0
- +18 FOR
- SET SUBFILE=$ORDER(LIST(SUBFILE))
- if 'SUBFILE
- QUIT
- Begin DoDot:1
- +19 SET ZKEY=""
- SET CNT=0
- +20 FOR
- SET ZKEY=$ORDER(LIST(SUBFILE,ZKEY))
- if ZKEY=""
- QUIT
- Begin DoDot:2
- +21 NEW IDX,ROOT
- +22 SET ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
- +23 SET IDX=$ORDER(@ROOT@("B",ZKEY,0))
- +24 IF $ORDER(@ROOT@("B",ZKEY,IDX))
- DO DELLIST(IDX)
- +25 IF 'IDX
- DO ADDLIST
- QUIT
- +26 SET FIELD=0
- +27 FOR
- SET FIELD=$ORDER(LIST(SUBFILE,ZKEY,FIELD))
- if 'FIELD
- QUIT
- Begin DoDot:3
- +28 NEW X
- SET X=$$GET1^DIQ(SUBFILE,IDX_","_IENS,FIELD)
- +29 SET VALUE=LIST(SUBFILE,ZKEY,FIELD)
- +30 if VALUE=X
- QUIT
- if (VALUE=""""&X="")
- QUIT
- +31 SET FDA(SUBFILE,IDX_","_IENS,FIELD)=VALUE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 ;
- +33 QUIT
- +34 ;
- ADDLIST ; -- add new sub-record
- +1 ;
- +2 NEW FDA
- +3 ;
- +4 SET CNT=$GET(CNT)+1
- +5 SET FIELD=0
- +6 FOR
- SET FIELD=$ORDER(LIST(SUBFILE,ZKEY,FIELD))
- if 'FIELD
- QUIT
- Begin DoDot:1
- +7 SET VALUE=LIST(SUBFILE,ZKEY,FIELD)
- if VALUE=""
- QUIT
- +8 SET FDA(SUBFILE,"+"_CNT_","_IENS,FIELD)=VALUE
- End DoDot:1
- +9 ;
- +10 if '$DATA(FDA)
- QUIT
- +11 ;
- +12 DO UPDATE^DIE(,"FDA",,"ERR")
- +13 IF $DATA(ERR)
- Begin DoDot:1
- +14 SET ERROR="1^subfile update error SUBFILE#: "_SUBFILE
- +15 DO EM(ERROR,.ERR)
- KILL ERR
- End DoDot:1
- QUIT
- +16 ;
- +17 QUIT
- +18 ;
- DELLIST(IDX) ; -- delete duplicate
- +1 ;
- +2 FOR
- SET IDX=$ORDER(@ROOT@("B",ZKEY,IDX))
- if 'IDX
- QUIT
- Begin DoDot:1
- +3 NEW DA,DIK,DIC
- SET DA(1)=+IENS
- SET DA=IDX
- SET DIK=$PIECE(ROOT,")")_","
- DO ^DIK
- End DoDot:1
- +4 ;
- +5 QUIT
- +6 ;
- UPDATE ; -- FileMan update
- +1 ;
- +2 if ERROR
- QUIT
- +3 if EXIT
- QUIT
- +4 ;
- +5 if $DATA(FDA)
- DO FILE^DIE(,"FDA","ERR")
- +6 IF $DATA(ERR)
- Begin DoDot:1
- +7 SET ERROR="1^updating error"
- +8 DO EM(ERROR,.ERR)
- KILL ERR
- End DoDot:1
- +9 ;
- +10 QUIT
- +11 ;
- ARRAY ; -- query data stored in array (not filed)
- +1 ;
- +2 SET ^TMP("XUMF ARRAY",$JOB,IFN,VUID,$PIECE(HLNODE,HLFS,2))=$PIECE(HLNODE,HLFS,3)
- +3 ;
- +4 QUIT
- +5 ;
- ADD ; -- ADD-processing logic
- +1 ;
- +2 NEW X
- +3 ;
- +4 SET X=$GET(^DIC(4.001,+IFN,3))
- if X'=""
- XECUTE X
- +5 ;
- +6 QUIT
- +7 ;
- MFE0 ; -- MFE-processing logic
- +1 ;if creating a new entry you must set IEN and other tasks performed in STUB^XUMF0 (if appropriate)
- +2 ;
- +3 NEW X
- +4 ;
- +5 SET X=$GET(^DIC(4.001,+IFN,4))
- if X'=""
- XECUTE X
- +6 ;
- +7 QUIT
- +8 ;
- ZRT0 ; -- ZRT-processing logic
- +1 ;
- +2 NEW X
- +3 ;
- +4 SET X=$GET(^DIC(4.001,+IFN,5))
- if X'=""
- XECUTE X
- +5 ;
- +6 QUIT
- +7 ;
- POST ; -- post-processing logic
- +1 ;
- +2 NEW X
- +3 ;
- +4 SET X=$GET(^DIC(4.001,+IFN,2))
- if X'=""
- XECUTE X
- +5 ;
- +6 QUIT
- +7 ;
- EXIT ; -- cleanup, and quit
- +1 ;
- +2 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB),^TMP("HLS",$JOB),^TMP("HLA",$JOB)
- +3 ;
- +4 KILL ^TMP("XUMF MFS",$JOB),^TMP("XUMF ERROR",$JOB),^TMP("XUMF EVENT",$JOB)
- +5 ;
- +6 QUIT
- +7 ;
- REPLY ; -- MFK
- +1 ;
- +2 NEW X,I,I1,I2,CNT
- +3 ;
- +4 SET CNT=1
- +5 SET X="MSA"_HLFS_$SELECT(ERROR:"AE",1:"AA")_HLFS_HL("MID")_HLFS_$PIECE(ERROR,U,2)
- +6 SET ^TMP("HLA",$JOB,CNT)=X
- +7 SET CNT=CNT+1
- +8 ;
- +9 SET I1=""
- SET I=0
- +10 FOR
- SET I1=$ORDER(^TMP("XUMF ERROR",$JOB,I1))
- if '$LENGTH(I1)
- QUIT
- Begin DoDot:1
- +11 SET I2=""
- FOR
- SET I2=$ORDER(^TMP("XUMF ERROR",$JOB,I1,I2))
- if '$LENGTH(I2)
- QUIT
- Begin DoDot:2
- +12 SET X=$GET(^(I2))
- +13 if '$LENGTH(X)
- QUIT
- +14 SET I=I+1
- +15 SET X="ERR"_HLFS_I_HLFS_$SELECT($ORDER(^TMP("XUMF ERROR",$JOB,I1))!$ORDER(^TMP("XUMF ERROR",$JOB,I1,I2)):1,1:0)_HLFS_X
- +16 SET ^TMP("HLA",$JOB,CNT)=X
- +17 SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 if ERROR
- DO EM^XUMF0
- +20 ;
- +21 DO GENACK^HLMA1($GET(HL("EID")),$GET(HLMTIENS),$GET(HL("EIDS")),"GM",1,.HLRESLT)
- +22 ;
- +23 QUIT
- +24 ;
- EM(ERROR,ERR) ; -- error message
- +1 ;
- +2 NEW X,I,Y
- +3 ;
- +4 DO MSG^DIALOG("AM",.X,80,,"ERR")
- +5 ;
- +6 SET ERRCNT=ERRCNT+1
- +7 ;
- +8 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".01")=""
- +9 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".02")=""
- +10 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".03")=$GET(ERROR)
- +11 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".04")=""
- +12 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".05")="VUID: "_$GET(VUID)_" IFN: "_$GET(IFN)_" IEN: "_IEN
- +13 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_".06")=""
- +14 SET X=.9
- FOR
- SET X=$ORDER(X(X))
- if 'X
- QUIT
- Begin DoDot:1
- +15 SET ^TMP("XUMF ERROR",$JOB,ERRCNT_"."_X)=X(X)
- End DoDot:1
- +16 ;
- +17 QUIT
- +18 ;
- STATUS ;
- +1 ;
- +2 IF VALUE=$PIECE($$GETSTAT^XTID(IFN,,IEN_","),U)
- QUIT
- +3 ;
- +4 IF SUBFILE=""
- SET ERROR="1^status parameter error"
- QUIT
- +5 ;
- +6 NEW FDA
- +7 SET FDA(SUBFILE,"?+1,"_IENS,.01)=$$NOW^XLFDT
- +8 SET FDA(SUBFILE,"?+1,"_IENS,.02)=VALUE
- +9 DO UPDATE^DIE(,"FDA",,"ERR")
- +10 IF $DATA(ERR)
- Begin DoDot:1
- +11 SET ERROR="1^effective date and status error"
- +12 DO EM(ERROR,.ERR)
- KILL ERR
- End DoDot:1
- +13 ;
- +14 QUIT
- +15 ;
- WP ;
- +1 ;
- +2 NEW X,Y,A,I,CNT,X1,X2,ESC
- +3 DO SEGPRSE^XUMFXHL7("HLNODE","X",HLFS,60)
- +4 ;
- +5 SET CNT=1
- +6 SET A(CNT)=X(2)
- +7 SET I=0
- +8 FOR
- SET I=$ORDER(X(2,I))
- if 'I
- QUIT
- Begin DoDot:1
- +9 SET Y=X(2,I)
- +10 IF $EXTRACT(Y,1)=" "
- Begin DoDot:2
- +11 SET A(CNT)=A(CNT)_" "
- +12 if $PIECE(Y," ",2)=""
- QUIT
- +13 SET CNT=CNT+1
- +14 SET A(CNT)=$PIECE(Y," ",2,99)
- End DoDot:2
- QUIT
- +15 SET X1=$PIECE(Y," ",1)
- +16 SET X2=$PIECE(Y," ",2,99)
- +17 SET A(CNT)=A(CNT)_X1_$SELECT(X2="":"",1:" ")
- +18 if X2=""
- QUIT
- +19 SET CNT=CNT+1
- +20 SET A(CNT)=X2
- End DoDot:1
- +21 ;
- +22 DO UNESCWP^XUMF0(.A,.HL)
- +23 ;
- +24 DO WP^DIE(IFN,IENS,FIELD,"K","A","ERR")
- +25 ;
- +26 IF $DATA(ERR)
- Begin DoDot:1
- +27 SET ERROR="1^wp field error"
- +28 DO EM(ERROR,.ERR)
- KILL ERR
- End DoDot:1
- +29 ;
- +30 QUIT
- +31 ;
- RECORD ;MFS event protocol data
- +1 ;
+2 NEW ROOT,NODE,NODE1,CHANGE,STATUS
+3 ;
+4 IF $GET(ERROR)
Begin DoDot:1
+5 SET ^TMP("XUMF EVENT",$JOB,"ERROR")=ERROR
+6 SET ^TMP("XUMF EVENT",$JOB,"ERROR",1)=$GET(IFN)_U_$GET(IEN)
End DoDot:1
QUIT
+7 ;
+8 SET ROOT=$$ROOT^DILFD(IFN,,1)
+9 MERGE RECORD("AFTER")=@ROOT@(IEN)
+10 ;
+11 IF $GET(RECORD("NEW"))
MERGE ^TMP("XUMF EVENT",$JOB,IFN,"NEW",IEN)=RECORD("AFTER")
QUIT
+12 ;
+13 SET ^TMP("XUMF EVENT",$JOB,IFN,"AFTER",IEN,"REPLACED BY")=$PIECE($GET(@ROOT@(IEN,"VUID")),U,3)
+14 SET ^TMP("XUMF EVENT",$JOB,IFN,"AFTER",IEN,"INHERITS FROM")=$$RPLCMNT^XTIDTRM(IFN,IEN)
+15 ;
+16 SET STATUS=$$GETSTAT^XTID(IFN,,IEN_",")
+17 IF RECORD("STATUS")'=STATUS
Begin DoDot:1
+18 SET ^TMP("XUMF EVENT",$JOB,IFN,"STATUS",IEN)=$PIECE(RECORD("STATUS"),U,1,2)_U_$PIECE(STATUS,U,1,2)
End DoDot:1
+19 ;
+20 SET NODE=$QUERY(RECORD("AFTER",""))
SET NODE1=$QUERY(RECORD("BEFORE",""))
SET CHANGE=0
+21 IF $PIECE(NODE,"RECORD(""AFTER")'=$PIECE(NODE1,"RECORD(""BEFORE")
SET CHANGE=1
+22 IF @NODE'=@NODE1
SET CHANGE=1
+23 IF 'CHANGE
FOR
SET NODE=$QUERY(@NODE)
if NODE=""!(NODE["(""BEFORE")
QUIT
Begin DoDot:1
+24 SET NODE1=$QUERY(@NODE1)
IF NODE1=""
SET CHANGE=1
QUIT
+25 IF $PIECE(NODE,"RECORD(""AFTER")'=$PIECE(NODE1,"RECORD(""BEFORE")
SET CHANGE=1
QUIT
+26 IF @NODE'=@NODE1
SET CHANGE=1
QUIT
End DoDot:1
if CHANGE
QUIT
+27 ;
+28 IF CHANGE
Begin DoDot:1
+29 MERGE ^TMP("XUMF EVENT",$JOB,IFN,"AFTER",IEN)=RECORD("AFTER")
+30 MERGE ^TMP("XUMF EVENT",$JOB,IFN,"BEFORE",IEN)=RECORD("BEFORE")
End DoDot:1
+31 ;
+32 QUIT
+33 ;