| 1 | HLCSMM ;ISC/MTC-Create Mail Message and Entry in the HL7 Transmission File ;11/03/2000 08:53
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**17,35,57,66,68**;Oct 13, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EN(HLD0,HLD1) ; This routine will send a Message from the Out Queue to the
|
|---|
| 6 | ; MailGroup Specified in the Logical Link file (#870). It is called
|
|---|
| 7 | ; from HLCSMM1 routine that monitors the queue for a link. The MM LLP
|
|---|
| 8 | ; uses <CR> stuffing to indicate the end of segments. The message
|
|---|
| 9 | ; will use the following format within the XMB global.
|
|---|
| 10 | ; ^XMB(3.9,..1)=Segment 1
|
|---|
| 11 | ; ^XMB(3.9,..2)="" - End of segment 1
|
|---|
| 12 | ; ^XMB(3.9,..3)=Segment 2
|
|---|
| 13 | ; ^XMB(3.9,..4)=Continuation of segment 2
|
|---|
| 14 | ; ^XMB(3.9,..5)="" - End of segment 2
|
|---|
| 15 | ; " "
|
|---|
| 16 | ; This processing will enable segment greater than 245.
|
|---|
| 17 | ;
|
|---|
| 18 | ; INPUT : HLD0 - IEN of Logical Link file (#870)
|
|---|
| 19 | ; : HLD1 - IEN of OutQueue Mutiple (Message)
|
|---|
| 20 | ;
|
|---|
| 21 | ; OUTPUT: NONE
|
|---|
| 22 | ;
|
|---|
| 23 | N HLI,HLI0,HLSERV,HLFAC,HLERR,HLOGLINK,HLMSTXT,HLPARENT,HLPTXT,HLPARM
|
|---|
| 24 | ;
|
|---|
| 25 | S HLOGLINK=$G(^HLCS(870,HLD0,0))
|
|---|
| 26 | ;-- get MailMan LLP parameters
|
|---|
| 27 | S HLPARM=$G(^HLCS(870,HLD0,100))
|
|---|
| 28 | ;-- facility
|
|---|
| 29 | S HLFAC=$P($$SITE^VASITE,"^",2)
|
|---|
| 30 | I HLFAC="" S HLFAC="Unknown"
|
|---|
| 31 | ;-- date
|
|---|
| 32 | D NOW^%DTC S Y=% X ^DD("DD") S HLDT=Y
|
|---|
| 33 | ;-- logical link name
|
|---|
| 34 | S HLDAN=$P(HLOGLINK,U)
|
|---|
| 35 | ;
|
|---|
| 36 | ;-- Build MailMan variables
|
|---|
| 37 | ;
|
|---|
| 38 | NEWMM ;Patch 66-introduce new Mailman API's
|
|---|
| 39 | N XMSUB,XMTO,XMINSTR
|
|---|
| 40 | I '$G(DUZ) N DUZ D DUZ^XUP(.5)
|
|---|
| 41 | S XMSUB="HL7 Msg "_HLDT_" from "_HLFAC,XMSUB=$E(XMSUB,1,65)
|
|---|
| 42 | S XMTO="G."_$P(^XMB(3.8,$P(HLPARM,U),0),U)
|
|---|
| 43 | S XMINSTR("FROM")=.5
|
|---|
| 44 | S XMINSTR("ADDR FLAGS")="R" ; Ignore any restrictions (domain closed or protected by security key)
|
|---|
| 45 | D SENDMSG^XMXAPI(DUZ,XMSUB,"^HLCS(870,HLD0,2,HLD1,1)",XMTO,.XMINSTR)
|
|---|
| 46 | ;-- Set message status to 'done'
|
|---|
| 47 | S $P(^HLCS(870,HLD0,2,HLD1,0),"^",2)="D"
|
|---|
| 48 | I $G(XMERR) D ERROR
|
|---|
| 49 | Q
|
|---|
| 50 | ERROR ;-- send Mail Message indicating error
|
|---|
| 51 | Q:'$G(XMERR)
|
|---|
| 52 | Q:'$D(^TMP("XMERR",$J))
|
|---|
| 53 | N HLX,HLY,HLZ,HLPARAM,XMSUB,XMTO,XMINSTR
|
|---|
| 54 | N DUZ D DUZ^XUP(.5) ; Want to make sure this message is sent. It won't be if DUZ is not a valid user.
|
|---|
| 55 | K ^TMP($J,"HLERR")
|
|---|
| 56 | S HLNXST="ERROR" D STATUS^HLCSMM1(HLNXST) H 1
|
|---|
| 57 | S HLPARAM=$$PARAM^HLCS2,XMTO("G."_$P(HLPARAM,U,8))="",XMTO(.5)=""
|
|---|
| 58 | S (HLX,HLZ)=0
|
|---|
| 59 | F S HLX=$O(^TMP("XMERR",$J,HLX)) Q:'HLX D
|
|---|
| 60 | . S HLZ=HLZ+1,^TMP($J,"HLERR",HLZ)=""
|
|---|
| 61 | . S HLY=0
|
|---|
| 62 | . F S HLY=$O(^TMP("XMERR",$J,HLX,"TEXT",HLY)) Q:'HLY D
|
|---|
| 63 | . . S HLZ=HLZ+1,^TMP($J,"HLERR",HLZ)=$G(^TMP("XMERR",$J,HLX,"TEXT",HLY))
|
|---|
| 64 | . I $D(^TMP("XMERR",$J,HLX,"PARAM","VALUE")) S HLZ=HLZ+1,^TMP($J,"HLERR",HLZ)=^TMP("XMERR",$J,HLX,"PARAM","VALUE")
|
|---|
| 65 | S HLZ=HLZ+1,^TMP($J,"HLERR",HLZ)=""
|
|---|
| 66 | S HLZ=HLZ+1,^TMP($J,"HLERR",HLZ)="HL7 Logical Link: "_$G(HLDAN)
|
|---|
| 67 | S XMSUB="Error handing HL7 message off to Mailman"
|
|---|
| 68 | S XMINSTR("FROM")="POSTMASTER" ; msg will appear new, nomatter who receives it.
|
|---|
| 69 | D SENDMSG^XMXAPI(DUZ,XMSUB,"^TMP($J,""HLERR"")",.XMTO,.XMINSTR)
|
|---|
| 70 | K ^TMP($J,"HLERR"),XMERR,^TMP("XMERR",$J)
|
|---|
| 71 | Q
|
|---|
