| 1 | HLEMSND ;ALB/CJM - Sends events to remote event servers;12 JUN 1997 10:00 am
 | 
|---|
| 2 |  ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | SENDALL ;send all events pending distribution to remote locations
 | 
|---|
| 5 |  L +^HLEV(776.4,"AK"):0
 | 
|---|
| 6 |  Q:'$T
 | 
|---|
| 7 |  D START^HLEVAPI()
 | 
|---|
| 8 |  N EVENT
 | 
|---|
| 9 |  S IDX="^HLEV(776.4,""AK"")"
 | 
|---|
| 10 |  S EVENT=0
 | 
|---|
| 11 |  F  S EVENT=$O(@IDX@(EVENT)) Q:'EVENT  D
 | 
|---|
| 12 |  .I $$SEND(EVENT)
 | 
|---|
| 13 |  .K @IDX@(EVENT)
 | 
|---|
| 14 |  L -^HLEV(776.4,"AK")
 | 
|---|
| 15 |  D CHECKOUT^HLEVAPI
 | 
|---|
| 16 |  Q
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | SEND(IEN) ;
 | 
|---|
| 20 |  ;Sends the event=IEN to its remote servers
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  N MSG,EVENT,TYPE,MAILMSG,DOMAIN
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 |  ;get the event
 | 
|---|
| 25 |  Q:'$$GET^HLEME(IEN,.EVENT) 0
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  ;get the event type
 | 
|---|
| 28 |  Q:'$$GET^HLEMT(EVENT("TYPE"),.TYPE) 0
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 |  ;are there any remote locations to send this event type?
 | 
|---|
| 31 |  S DOMAIN=0
 | 
|---|
| 32 |  F  S DOMAIN=$O(TYPE("DOMAIN",DOMAIN)) Q:'DOMAIN  D
 | 
|---|
| 33 |  .I '$L(TYPE("DOMAIN",DOMAIN)) S DOMAIN(DOMAIN)="" Q
 | 
|---|
| 34 |  .;
 | 
|---|
| 35 |  .;there is a screen, execute it
 | 
|---|
| 36 |  .N HLEVENT
 | 
|---|
| 37 |  .M HLEVENT=EVENT
 | 
|---|
| 38 |  .N EVENT
 | 
|---|
| 39 |  .X TYPE("DOMAIN",DOMAIN)
 | 
|---|
| 40 |  .I $T S DOMAIN(DOMAIN)=""
 | 
|---|
| 41 |  Q:'$O(DOMAIN(0)) 0  ;there are no remote locations!
 | 
|---|
| 42 |  ;
 | 
|---|
| 43 |  ;location of where the message will be built, referenced by indirection
 | 
|---|
| 44 |  S MSG="^TMP($J,""HL7 MONITOR EVENT"")"
 | 
|---|
| 45 |  K @MSG
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  D BUILD(MSG,.EVENT,.TYPE)
 | 
|---|
| 48 |  S MAILMSG=$$MAIL(MSG,.DOMAIN)
 | 
|---|
| 49 |  I MAILMSG'="" D
 | 
|---|
| 50 |  .N DA,DATA,ERROR
 | 
|---|
| 51 |  .S DA(1)=IEN
 | 
|---|
| 52 |  .S DATA(.01)=MAILMSG
 | 
|---|
| 53 |  .I '$$ADD^HLEMU(776.42,.DA,.DATA,.ERROR) D
 | 
|---|
| 54 |  ..D ERROR(.EVENT)
 | 
|---|
| 55 |  ..I '$D(ZTQUEUED) W !,"FAILED TO ADD THE MAILMAN MESSAGE NUMBER TO THE EVENT ",ERROR ;then fileman failed!
 | 
|---|
| 56 |  E  D
 | 
|---|
| 57 |  .D ERROR(.EVENT)
 | 
|---|
| 58 |  .I '$D(ZTQUEUED) W !,"MAILMAN FAILED TO SEND HL7 LOG EVENT TO REMOTE SERVER"
 | 
|---|
| 59 |  K @MSG
 | 
|---|
| 60 |  Q 1
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 | BUILD(MSG,EVENT,TYPE) ;
 | 
|---|
| 63 |  ;EVENT - event array, pass by reference
 | 
|---|
| 64 |  ;TYPE - event type array, pass by reference
 | 
|---|
| 65 |  ;
 | 
|---|
| 66 |  N SUB,LINE,TXT
 | 
|---|
| 67 |  ;
 | 
|---|
| 68 |  ;can't send local pointers!
 | 
|---|
| 69 |  S EVENT("SITE")=$$STATNUM^HLEMU(EVENT("SITE"))
 | 
|---|
| 70 |  S EVENT("TYPE")=$$GETFIELD^HLEMU(9.4,.01,TYPE("PACKAGE"))_"^"_TYPE("CODE")
 | 
|---|
| 71 |  S EVENT("REVIEWER")=""
 | 
|---|
| 72 |  ;
 | 
|---|
| 73 |  S SUB=""
 | 
|---|
| 74 |  F  S SUB=$O(EVENT(SUB)) Q:(SUB="")  D:$D(EVENT(SUB))'[0
 | 
|---|
| 75 |  .D ADDDATA(MSG,SUB,EVENT(SUB))
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 |  ;add the application data
 | 
|---|
| 78 |  D ADDLINE(MSG,"**APPLICATION DATA**")
 | 
|---|
| 79 |  S LINE=0
 | 
|---|
| 80 |  F  S LINE=$O(^HLEV(776.4,EVENT("IEN"),3,LINE)) Q:'LINE  D
 | 
|---|
| 81 |  .S TXT=$G(^HLEV(776.4,EVENT("IEN"),3,LINE,0))
 | 
|---|
| 82 |  .Q:'$L(TXT)
 | 
|---|
| 83 |  .D ADDDATA(MSG,"VARIABLE",TXT)
 | 
|---|
| 84 |  .S TXT=$G(^HLEV(776.4,EVENT("IEN"),3,LINE,2))
 | 
|---|
| 85 |  .D ADDDATA(MSG,"VALUE",TXT)
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  ;add the notes
 | 
|---|
| 88 |  D ADDLINE(MSG,"**NOTES**")
 | 
|---|
| 89 |  S LINE=0
 | 
|---|
| 90 |  F  S LINE=$O(^HLEV(776.4,EVENT("IEN"),1,LINE)) Q:'LINE  D
 | 
|---|
| 91 |  .S TXT=$G(^HLEV(776.4,EVENT("IEN"),1,LINE,0))
 | 
|---|
| 92 |  .D:$L(TXT) ADDLINE(MSG,TXT)
 | 
|---|
| 93 |  Q
 | 
|---|
| 94 |  ;
 | 
|---|
| 95 | MAIL(MSG,DOMAIN) ;
 | 
|---|
| 96 |  ;Sends the message located at @MSG to the HLEM EVENT SERVER, locations in TYPE("DOMAIN") array
 | 
|---|
| 97 |  ;Input:
 | 
|---|
| 98 |  ;    message at @MSG
 | 
|---|
| 99 |  ;    DOMAIN - array of remote domains, pass by reference
 | 
|---|
| 100 |  ;Output: If succssful, the function returns the mailman message number, otherwise, "" is returned
 | 
|---|
| 101 |  ;
 | 
|---|
| 102 |  N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM,SERVER
 | 
|---|
| 103 |  S SERVER="S.HLEM EVENT LOG SERVER"
 | 
|---|
| 104 |  S XMDUZ="HL7 EVENT LOG at "_$P($$SITE^VASITE(),"^",2)
 | 
|---|
| 105 |  S XMY(.5)=""
 | 
|---|
| 106 |  S DOMAIN=0 F  S DOMAIN=$O(DOMAIN(DOMAIN)) Q:'DOMAIN  D
 | 
|---|
| 107 |  .S XMY(SERVER_"@"_$P($G(^DIC(4.2,DOMAIN,0)),"^"))=""
 | 
|---|
| 108 |  ;
 | 
|---|
| 109 |  ;******REMOVE THIS *****
 | 
|---|
| 110 |  ;S XMY("MOORE,JIM")=""
 | 
|---|
| 111 |  ;******
 | 
|---|
| 112 |  ;
 | 
|---|
| 113 |  S XMTEXT=$P(MSG,")")_","
 | 
|---|
| 114 |  S XMSUB="HL7 EVENT LOG"
 | 
|---|
| 115 |  D ^XMD
 | 
|---|
| 116 |  Q $G(XMZ)
 | 
|---|
| 117 |  ;
 | 
|---|
| 118 | ADDDATA(MSG,LABEL,DATA) ;
 | 
|---|
| 119 |  ;Description: Adds one formated line to the message text containing the label and data value
 | 
|---|
| 120 |  ;Input:
 | 
|---|
| 121 |  ;  MSG - the workspace location
 | 
|---|
| 122 |  ;  LABEL - text label that identifies the type of data
 | 
|---|
| 123 |  ;  DATA - data value
 | 
|---|
| 124 |  ;Output:none
 | 
|---|
| 125 |  ; 
 | 
|---|
| 126 |  D ADDLINE(MSG,LABEL_":"_DATA)
 | 
|---|
| 127 |  Q
 | 
|---|
| 128 |  ;
 | 
|---|
| 129 | ADDLINE(MSG,LINE) ;
 | 
|---|
| 130 |  ;Description: adds one line to the message text
 | 
|---|
| 131 |  ;Inputs:
 | 
|---|
| 132 |  ;  LINE - the line of text to be added
 | 
|---|
| 133 |  ;  MSG - @MSG is the location for the message text
 | 
|---|
| 134 |  ;Output: none
 | 
|---|
| 135 |  S @MSG@(($O(@MSG@(9999),-1)+1))=LINE
 | 
|---|
| 136 |  Q
 | 
|---|
| 137 |  ;
 | 
|---|
| 138 | ERROR(EVENT) ;
 | 
|---|
| 139 |  ;establishes a new event if this routine encounters an error.
 | 
|---|
| 140 |  ;pass EVENT by reference
 | 
|---|
| 141 |  ;
 | 
|---|
| 142 |  N NEWEVENT,VAR
 | 
|---|
| 143 |  S NEWEVENT=$$EVENT^HLEME("SRVR ERROR","HEALTH LEVEL SEVEN")
 | 
|---|
| 144 |  S VAR("IEN")=EVENT("IEN")
 | 
|---|
| 145 |  S VAR("ID")=EVENT("ID")
 | 
|---|
| 146 |  I $$STOREVAR^HLEME(NEWEVENT,.VAR)
 | 
|---|
| 147 |  Q
 | 
|---|