source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSMM.m@ 1593

Last change on this file since 1593 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1HLCSMM ;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 ;
5EN(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 ;
38NEWMM ;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
50ERROR ;-- 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
Note: See TracBrowser for help on using the repository browser.