HLEMSND ;ALB/CJM - Sends events to remote event servers;12 JUN 1997 10:00 am
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
;
SENDALL ;send all events pending distribution to remote locations
L +^HLEV(776.4,"AK"):0
Q:'$T
D START^HLEVAPI()
N EVENT
S IDX="^HLEV(776.4,""AK"")"
S EVENT=0
F S EVENT=$O(@IDX@(EVENT)) Q:'EVENT D
.I $$SEND(EVENT)
.K @IDX@(EVENT)
L -^HLEV(776.4,"AK")
D CHECKOUT^HLEVAPI
Q
;
;
SEND(IEN) ;
;Sends the event=IEN to its remote servers
;
N MSG,EVENT,TYPE,MAILMSG,DOMAIN
;
;get the event
Q:'$$GET^HLEME(IEN,.EVENT) 0
;
;get the event type
Q:'$$GET^HLEMT(EVENT("TYPE"),.TYPE) 0
;
;are there any remote locations to send this event type?
S DOMAIN=0
F S DOMAIN=$O(TYPE("DOMAIN",DOMAIN)) Q:'DOMAIN D
.I '$L(TYPE("DOMAIN",DOMAIN)) S DOMAIN(DOMAIN)="" Q
.;
.;there is a screen, execute it
.N HLEVENT
.M HLEVENT=EVENT
.N EVENT
.X TYPE("DOMAIN",DOMAIN)
.I $T S DOMAIN(DOMAIN)=""
Q:'$O(DOMAIN(0)) 0 ;there are no remote locations!
;
;location of where the message will be built, referenced by indirection
S MSG="^TMP($J,""HL7 MONITOR EVENT"")"
K @MSG
;
D BUILD(MSG,.EVENT,.TYPE)
S MAILMSG=$$MAIL(MSG,.DOMAIN)
I MAILMSG'="" D
.N DA,DATA,ERROR
.S DA(1)=IEN
.S DATA(.01)=MAILMSG
.I '$$ADD^HLEMU(776.42,.DA,.DATA,.ERROR) D
..D ERROR(.EVENT)
..I '$D(ZTQUEUED) W !,"FAILED TO ADD THE MAILMAN MESSAGE NUMBER TO THE EVENT ",ERROR ;then fileman failed!
E D
.D ERROR(.EVENT)
.I '$D(ZTQUEUED) W !,"MAILMAN FAILED TO SEND HL7 LOG EVENT TO REMOTE SERVER"
K @MSG
Q 1
;
BUILD(MSG,EVENT,TYPE) ;
;EVENT - event array, pass by reference
;TYPE - event type array, pass by reference
;
N SUB,LINE,TXT
;
;can't send local pointers!
S EVENT("SITE")=$$STATNUM^HLEMU(EVENT("SITE"))
S EVENT("TYPE")=$$GETFIELD^HLEMU(9.4,.01,TYPE("PACKAGE"))_"^"_TYPE("CODE")
S EVENT("REVIEWER")=""
;
S SUB=""
F S SUB=$O(EVENT(SUB)) Q:(SUB="") D:$D(EVENT(SUB))'[0
.D ADDDATA(MSG,SUB,EVENT(SUB))
;
;add the application data
D ADDLINE(MSG,"**APPLICATION DATA**")
S LINE=0
F S LINE=$O(^HLEV(776.4,EVENT("IEN"),3,LINE)) Q:'LINE D
.S TXT=$G(^HLEV(776.4,EVENT("IEN"),3,LINE,0))
.Q:'$L(TXT)
.D ADDDATA(MSG,"VARIABLE",TXT)
.S TXT=$G(^HLEV(776.4,EVENT("IEN"),3,LINE,2))
.D ADDDATA(MSG,"VALUE",TXT)
;
;add the notes
D ADDLINE(MSG,"**NOTES**")
S LINE=0
F S LINE=$O(^HLEV(776.4,EVENT("IEN"),1,LINE)) Q:'LINE D
.S TXT=$G(^HLEV(776.4,EVENT("IEN"),1,LINE,0))
.D:$L(TXT) ADDLINE(MSG,TXT)
Q
;
MAIL(MSG,DOMAIN) ;
;Sends the message located at @MSG to the HLEM EVENT SERVER, locations in TYPE("DOMAIN") array
;Input:
; message at @MSG
; DOMAIN - array of remote domains, pass by reference
;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned
;
N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER
S SERVER="S.HLEM EVENT LOG SERVER"
S XMDUZ="HL7 EVENT LOG at "_$P($$SITE^VASITE(),"^",2)
S XMY(.5)=""
S DOMAIN=0 F S DOMAIN=$O(DOMAIN(DOMAIN)) Q:'DOMAIN D
.S XMY(SERVER_"@"_$P($G(^DIC(4.2,DOMAIN,0)),"^"))=""
;
;******REMOVE THIS *****
;S XMY("MOORE,JIM")=""
;******
;
S XMTEXT=$P(MSG,")")_","
S XMSUB="HL7 EVENT LOG"
D ^XMD
Q $G(XMZ)
;
ADDDATA(MSG,LABEL,DATA) ;
;Description: Adds one formated line to the message text containing the label and data value
;Input:
; MSG - the workspace location
; LABEL - text label that identifies the type of data
; DATA - data value
;Output:none
;
D ADDLINE(MSG,LABEL_":"_DATA)
Q
;
ADDLINE(MSG,LINE) ;
;Description: adds one line to the message text
;Inputs:
; LINE - the line of text to be added
; MSG - @MSG is the location for the message text
;Output: none
S @MSG@(($O(@MSG@(9999),-1)+1))=LINE
Q
;
ERROR(EVENT) ;
;establishes a new event if this routine encounters an error.
;pass EVENT by reference
;
N NEWEVENT,VAR
S NEWEVENT=$$EVENT^HLEME("SRVR ERROR","HEALTH LEVEL SEVEN")
S VAR("IEN")=EVENT("IEN")
S VAR("ID")=EVENT("ID")
I $$STOREVAR^HLEME(NEWEVENT,.VAR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEMSND 4098 printed Sep 23, 2025@19:33:40 Page 2
HLEMSND ;ALB/CJM - Sends events to remote event servers;12 JUN 1997 10:00 am
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
+2 ;
SENDALL ;send all events pending distribution to remote locations
+1 LOCK +^HLEV(776.4,"AK"):0
+2 if '$TEST
QUIT
+3 DO START^HLEVAPI()
+4 NEW EVENT
+5 SET IDX="^HLEV(776.4,""AK"")"
+6 SET EVENT=0
+7 FOR
SET EVENT=$ORDER(@IDX@(EVENT))
if 'EVENT
QUIT
Begin DoDot:1
+8 IF $$SEND(EVENT)
+9 KILL @IDX@(EVENT)
End DoDot:1
+10 LOCK -^HLEV(776.4,"AK")
+11 DO CHECKOUT^HLEVAPI
+12 QUIT
+13 ;
+14 ;
SEND(IEN) ;
+1 ;Sends the event=IEN to its remote servers
+2 ;
+3 NEW MSG,EVENT,TYPE,MAILMSG,DOMAIN
+4 ;
+5 ;get the event
+6 if '$$GET^HLEME(IEN,.EVENT)
QUIT 0
+7 ;
+8 ;get the event type
+9 if '$$GET^HLEMT(EVENT("TYPE"),.TYPE)
QUIT 0
+10 ;
+11 ;are there any remote locations to send this event type?
+12 SET DOMAIN=0
+13 FOR
SET DOMAIN=$ORDER(TYPE("DOMAIN",DOMAIN))
if 'DOMAIN
QUIT
Begin DoDot:1
+14 IF '$LENGTH(TYPE("DOMAIN",DOMAIN))
SET DOMAIN(DOMAIN)=""
QUIT
+15 ;
+16 ;there is a screen, execute it
+17 NEW HLEVENT
+18 MERGE HLEVENT=EVENT
+19 NEW EVENT
+20 XECUTE TYPE("DOMAIN",DOMAIN)
+21 IF $TEST
SET DOMAIN(DOMAIN)=""
End DoDot:1
+22 ;there are no remote locations!
if '$ORDER(DOMAIN(0))
QUIT 0
+23 ;
+24 ;location of where the message will be built, referenced by indirection
+25 SET MSG="^TMP($J,""HL7 MONITOR EVENT"")"
+26 KILL @MSG
+27 ;
+28 DO BUILD(MSG,.EVENT,.TYPE)
+29 SET MAILMSG=$$MAIL(MSG,.DOMAIN)
+30 IF MAILMSG'=""
Begin DoDot:1
+31 NEW DA,DATA,ERROR
+32 SET DA(1)=IEN
+33 SET DATA(.01)=MAILMSG
+34 IF '$$ADD^HLEMU(776.42,.DA,.DATA,.ERROR)
Begin DoDot:2
+35 DO ERROR(.EVENT)
+36 ;then fileman failed!
IF '$DATA(ZTQUEUED)
WRITE !,"FAILED TO ADD THE MAILMAN MESSAGE NUMBER TO THE EVENT ",ERROR
End DoDot:2
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 DO ERROR(.EVENT)
+39 IF '$DATA(ZTQUEUED)
WRITE !,"MAILMAN FAILED TO SEND HL7 LOG EVENT TO REMOTE SERVER"
End DoDot:1
+40 KILL @MSG
+41 QUIT 1
+42 ;
BUILD(MSG,EVENT,TYPE) ;
+1 ;EVENT - event array, pass by reference
+2 ;TYPE - event type array, pass by reference
+3 ;
+4 NEW SUB,LINE,TXT
+5 ;
+6 ;can't send local pointers!
+7 SET EVENT("SITE")=$$STATNUM^HLEMU(EVENT("SITE"))
+8 SET EVENT("TYPE")=$$GETFIELD^HLEMU(9.4,.01,TYPE("PACKAGE"))_"^"_TYPE("CODE")
+9 SET EVENT("REVIEWER")=""
+10 ;
+11 SET SUB=""
+12 FOR
SET SUB=$ORDER(EVENT(SUB))
if (SUB="")
QUIT
if $DATA(EVENT(SUB))'[0
Begin DoDot:1
+13 DO ADDDATA(MSG,SUB,EVENT(SUB))
End DoDot:1
+14 ;
+15 ;add the application data
+16 DO ADDLINE(MSG,"**APPLICATION DATA**")
+17 SET LINE=0
+18 FOR
SET LINE=$ORDER(^HLEV(776.4,EVENT("IEN"),3,LINE))
if 'LINE
QUIT
Begin DoDot:1
+19 SET TXT=$GET(^HLEV(776.4,EVENT("IEN"),3,LINE,0))
+20 if '$LENGTH(TXT)
QUIT
+21 DO ADDDATA(MSG,"VARIABLE",TXT)
+22 SET TXT=$GET(^HLEV(776.4,EVENT("IEN"),3,LINE,2))
+23 DO ADDDATA(MSG,"VALUE",TXT)
End DoDot:1
+24 ;
+25 ;add the notes
+26 DO ADDLINE(MSG,"**NOTES**")
+27 SET LINE=0
+28 FOR
SET LINE=$ORDER(^HLEV(776.4,EVENT("IEN"),1,LINE))
if 'LINE
QUIT
Begin DoDot:1
+29 SET TXT=$GET(^HLEV(776.4,EVENT("IEN"),1,LINE,0))
+30 if $LENGTH(TXT)
DO ADDLINE(MSG,TXT)
End DoDot:1
+31 QUIT
+32 ;
MAIL(MSG,DOMAIN) ;
+1 ;Sends the message located at @MSG to the HLEM EVENT SERVER, locations in TYPE("DOMAIN") array
+2 ;Input:
+3 ; message at @MSG
+4 ; DOMAIN - array of remote domains, pass by reference
+5 ;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned
+6 ;
+7 NEW XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER
+8 SET SERVER="S.HLEM EVENT LOG SERVER"
+9 SET XMDUZ="HL7 EVENT LOG at "_$PIECE($$SITE^VASITE(),"^",2)
+10 SET XMY(.5)=""
+11 SET DOMAIN=0
FOR
SET DOMAIN=$ORDER(DOMAIN(DOMAIN))
if 'DOMAIN
QUIT
Begin DoDot:1
+12 SET XMY(SERVER_"@"_$PIECE($GET(^DIC(4.2,DOMAIN,0)),"^"))=""
End DoDot:1
+13 ;
+14 ;******REMOVE THIS *****
+15 ;S XMY("MOORE,JIM")=""
+16 ;******
+17 ;
+18 SET XMTEXT=$PIECE(MSG,")")_","
+19 SET XMSUB="HL7 EVENT LOG"
+20 DO ^XMD
+21 QUIT $GET(XMZ)
+22 ;
ADDDATA(MSG,LABEL,DATA) ;
+1 ;Description: Adds one formated line to the message text containing the label and data value
+2 ;Input:
+3 ; MSG - the workspace location
+4 ; LABEL - text label that identifies the type of data
+5 ; DATA - data value
+6 ;Output:none
+7 ;
+8 DO ADDLINE(MSG,LABEL_":"_DATA)
+9 QUIT
+10 ;
ADDLINE(MSG,LINE) ;
+1 ;Description: adds one line to the message text
+2 ;Inputs:
+3 ; LINE - the line of text to be added
+4 ; MSG - @MSG is the location for the message text
+5 ;Output: none
+6 SET @MSG@(($ORDER(@MSG@(9999),-1)+1))=LINE
+7 QUIT
+8 ;
ERROR(EVENT) ;
+1 ;establishes a new event if this routine encounters an error.
+2 ;pass EVENT by reference
+3 ;
+4 NEW NEWEVENT,VAR
+5 SET NEWEVENT=$$EVENT^HLEME("SRVR ERROR","HEALTH LEVEL SEVEN")
+6 SET VAR("IEN")=EVENT("IEN")
+7 SET VAR("ID")=EVENT("ID")
+8 IF $$STOREVAR^HLEME(NEWEVENT,.VAR)
+9 QUIT
