HLEMRCV ;ALB/CJM - Mailman server for HL7 Monitoring Events;12 JUN 1997 10:00 am
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
;
RECEIVE ;Description: Read the exception message and file it.
;!!!! for testing interactively !!!!!!!!!!!!
;S XMER=0
;S XMFROM="HL7 EVENT LOG AT SAN FRANCISCO"
;S XMPOS=0
;S XMREC="D REC^XMS3"
;S XMRG="**APPLICATION DATA**"
;S XMXX="S.HLEM EVENT LOG SERVER"
;S XMZ=8557
;!!!!!!
;
N EVENT,EXIT,TEMP
S EXIT=0
F X XMREC Q:(XMER<0) D Q:EXIT
.I $E(XMRG,1,2)="**" S EXIT=1 Q
.N LABEL,DATA
.S LABEL=$P(XMRG,":"),DATA=$P(XMRG,":",2,99)
.Q:'$L(LABEL)
.S EVENT(LABEL)=DATA
;
;don't save IEN from sending site
K EVENT("IEN")
;
;need to get local pointers
;event type
S:$D(EVENT("TYPE")) TEMP=$$FIND^HLEMT($P($G(EVENT("TYPE")),"^",2),$P($G(EVENT("TYPE")),"^"))
I '$G(TEMP) D ERROR("UNKNOWN EVENT TYPE AT REMOTE SITE: "_EVENT("TYPE"),XMZ) Q
S EVENT("TYPE")=TEMP
;get the institution ien
S:$D(EVENT("SITE")) EVENT("SITE")=$$INSTIEN^HLEMU(EVENT("SITE"))
;
;don't enter duplicates (no updating at present)
I $L($G(EVENT("ID"))),$D(^HLEV(776.4,"C",EVENT("ID"))) Q
;
;establish this event on this system
S EVENT=$$STORE^HLEME1(.EVENT,.ERROR)
;
;if successful
I EVENT D
.;add a note with the ien of the message for traceability
.I $$ADDNOTE^HLEME(EVENT,"REMOTE EVENT ADDED BY SERVER AT "_$$NOW^XLFDT_", MAILMAN MESSAGE IEN: "_$G(XMZ))
;
;if not successful
I 'EVENT D ERROR("Fileman Failed to store remote event: "_$G(ERROR),$G(XMZ)) Q
;
;handle application data
I $E(XMRG,1,4)="**AP" D
.S EXIT=0
.F X XMREC Q:(XMER<0) D Q:EXIT
..I $E(XMRG,1,4)="**NO" S EXIT=1 Q
..N VAR
..I $P(XMRG,":")="VARIABLE" D
...S VAR=$P(XMRG,":",2)
...X XMREC
...I $P(XMRG,":")="VALUE" S @VAR=$P(XMRG,":",2,99) I $$STOREVAR^HLEME(EVENT,.@VAR,VAR)
;
;handle notes
I $E(XMRG,1,4)="**NO" D
.S EXIT=0
.F X XMREC Q:(XMER<0) D Q:EXIT
..N VAR
..I $P(XMRG,":")="VAR" D
...S VAR=$P(XMRG,":",2)
...X XMREC
...I $L(XMRG) D
..I $$ADDNOTE^HLEME(EVENT,XMRG)
;
S XMSER="S.HLEM EVENT LOG SERVER"
D REMSBMSG^XMA1C
Q
;
ERROR(COMMENT,MAIL) ;
;establishes a new event if this routine encounters an error.
;MAIL is the message id of the MailMan mesage
;
N NEWEVENT,VAR
S NEWEVENT=$$EVENT^HLEME("SRVR ERROR","HEALTH LEVEL SEVEN")
S VAR("MAIL IEN")=$G(MAIL)
I $$STOREVAR^HLEME(NEWEVENT,.VAR)
I $$ADDNOTE^HLEME(NEWEVENT,$G(COMMENT))
Q
HLEMRCV ;ALB/CJM - Mailman server for HL7 Monitoring Events;12 JUN 1997 10:00 am
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
+2 ;
RECEIVE ;Description: Read the exception message and file it.
+1 ;!!!! for testing interactively !!!!!!!!!!!!
+2 ;S XMER=0
+3 ;S XMFROM="HL7 EVENT LOG AT SAN FRANCISCO"
+4 ;S XMPOS=0
+5 ;S XMREC="D REC^XMS3"
+6 ;S XMRG="**APPLICATION DATA**"
+7 ;S XMXX="S.HLEM EVENT LOG SERVER"
+8 ;S XMZ=8557
+9 ;!!!!!!
+10 ;
+11 NEW EVENT,EXIT,TEMP
+12 SET EXIT=0
+13 FOR
XECUTE XMREC
IF (XMER<0)
QUIT
Begin DoDot:1
+14 IF $EXTRACT(XMRG,1,2)="**"
SET EXIT=1
QUIT
+15 NEW LABEL,DATA
+16 SET LABEL=$PIECE(XMRG,":")
SET DATA=$PIECE(XMRG,":",2,99)
+17 IF '$LENGTH(LABEL)
QUIT
+18 SET EVENT(LABEL)=DATA
End DoDot:1
IF EXIT
QUIT
+19 ;
+20 ;don't save IEN from sending site
+21 KILL EVENT("IEN")
+22 ;
+23 ;need to get local pointers
+24 ;event type
+25 IF $DATA(EVENT("TYPE"))
SET TEMP=$$FIND^HLEMT($PIECE($GET(EVENT("TYPE")),"^",2),$PIECE($GET(EVENT("TYPE")),"^"))
+26 IF '$GET(TEMP)
DO ERROR("UNKNOWN EVENT TYPE AT REMOTE SITE: "_EVENT("TYPE"),XMZ)
QUIT
+27 SET EVENT("TYPE")=TEMP
+28 ;get the institution ien
+29 IF $DATA(EVENT("SITE"))
SET EVENT("SITE")=$$INSTIEN^HLEMU(EVENT("SITE"))
+30 ;
+31 ;don't enter duplicates (no updating at present)
+32 IF $LENGTH($GET(EVENT("ID")))
IF $DATA(^HLEV(776.4,"C",EVENT("ID")))
QUIT
+33 ;
+34 ;establish this event on this system
+35 SET EVENT=$$STORE^HLEME1(.EVENT,.ERROR)
+36 ;
+37 ;if successful
+38 IF EVENT
Begin DoDot:1
+39 ;add a note with the ien of the message for traceability
+40 IF $$ADDNOTE^HLEME(EVENT,"REMOTE EVENT ADDED BY SERVER AT "_$$NOW^XLFDT_", MAILMAN MESSAGE IEN: "_$G(XMZ))
End DoDot:1
+41 ;
+42 ;if not successful
+43 IF 'EVENT
DO ERROR("Fileman Failed to store remote event: "_$GET(ERROR),$GET(XMZ))
QUIT
+44 ;
+45 ;handle application data
+46 IF $EXTRACT(XMRG,1,4)="**AP"
Begin DoDot:1
+47 SET EXIT=0
+48 FOR
XECUTE XMREC
IF (XMER<0)
QUIT
Begin DoDot:2
+49 IF $EXTRACT(XMRG,1,4)="**NO"
SET EXIT=1
QUIT
+50 NEW VAR
+51 IF $PIECE(XMRG,":")="VARIABLE"
Begin DoDot:3
+52 SET VAR=$PIECE(XMRG,":",2)
+53 XECUTE XMREC
+54 IF $PIECE(XMRG,":")="VALUE"
SET @VAR=$PIECE(XMRG,":",2,99)
IF $$STOREVAR^HLEME(EVENT,.@VAR,VAR)
End DoDot:3
End DoDot:2
IF EXIT
QUIT
End DoDot:1
+55 ;
+56 ;handle notes
+57 IF $EXTRACT(XMRG,1,4)="**NO"
Begin DoDot:1
+58 SET EXIT=0
+59 FOR
XECUTE XMREC
IF (XMER<0)
QUIT
Begin DoDot:2
+60 NEW VAR
+61 IF $PIECE(XMRG,":")="VAR"
Begin DoDot:3
+62 SET VAR=$PIECE(XMRG,":",2)
+63 XECUTE XMREC
+64 IF $LENGTH(XMRG)
Begin DoDot:4
End DoDot:4
End DoDot:3
+65 IF $$ADDNOTE^HLEME(EVENT,XMRG)
End DoDot:2
IF EXIT
QUIT
End DoDot:1
+66 ;
+67 SET XMSER="S.HLEM EVENT LOG SERVER"
+68 DO REMSBMSG^XMA1C
+69 QUIT
+70 ;
ERROR(COMMENT,MAIL) ;
+1 ;establishes a new event if this routine encounters an error.
+2 ;MAIL is the message id of the MailMan mesage
+3 ;
+4 NEW NEWEVENT,VAR
+5 SET NEWEVENT=$$EVENT^HLEME("SRVR ERROR","HEALTH LEVEL SEVEN")
+6 SET VAR("MAIL IEN")=$GET(MAIL)
+7 IF $$STOREVAR^HLEME(NEWEVENT,.VAR)
+8 IF $$ADDNOTE^HLEME(NEWEVENT,$GET(COMMENT))
+9 QUIT
