source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUHL1.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1DGRUHL1 ;ALB/SCK - RAI/MDS HL7 MESSAGING ACKNOWLEDGEMENT ROUTINES ; 7-9-1999
2 ;;5.3;Registration;**190,354,419**;Aug 13, 1993
3 ;
4ACK ; Receives the ACK messages
5 ; Input : All variables set by the HL7 package
6 ; Output : None
7 ;
8 N DGI,DGX,DGMSG,DGACK,DGPARAM,HLNODE,I,X
9 ;
10 ;Get message text
11 S ^TMP("DGRUACK",$H)="START PROCESS"
12 F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
13 . S DGMSG(I,1)=HLNODE
14 . ; Check for segment length greater than 245
15 . S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGMSG(I,(X+1))=HLNODE(X)
16 ;
17 M ^TMP("DGRUACK",$H,"HL")=DGMSG
18 ; analyze the message and take appropriate response
19 ; Quit if there is no valid message header
20 Q:$P(DGMSG(1,1),"^")'="MSH"
21 ;
22 S X=1,DGPARAM=""
23 F S X=+$O(DGMSG(X)) Q:('X) D
24 . I $P(DGMSG(X,1),"^")="MSA" D
25 .. D PROCESS(DGMSG(X,1),.DGPARAM)
26 .. D NOTIFY
27 Q
28 ;
29NOTIFY ; TAsk sending of response notification
30 ;
31 Q:$O(DGPARAM(""))="" ;added p-354
32 D SENDIT
33 Q
34 ;
35SENDIT ; Notify mail group that a response message was received from the RAI/MDS COTS system
36 ; Input : MSGARY() - Array containing HL7 message received
37 ; Output : None
38 ;
39 N MSGTXT,XMY,XMTEXT,XMY,XMDUZ,XMDT,XMZ,LINE,XMB,XMCHAN,XMSUB
40 ;
41 S XMCHAN=1
42 S XMSUB="RAI/MDS Message Receipt for "_DGPARAM(1)
43 S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
44 ;
45 M XMB=DGPARAM
46 S XMB="DGRU REJECT"
47 S XMDT=DT
48 D ^XMB
49 Q
50 ;
51PROCESS(DGMSG,DGPARAM) ;
52 N ACK,MSGID
53 ;
54 Q:$G(DGMSG)']""
55 ;
56 S ACK=$P(DGMSG,"^",2) ; Get acknowledgement code
57 ; If the acknowledgement code is AA, then do not send notification
58 Q:ACK="AA" ;changed p-354
59 ;
60 ; Get outgoing message ID
61 S MSGID=$P(DGMSG,"^",3)
62 ;
63 ; Retrieve outgoing message information from file #773 for message ID
64 D EXTRACT(MSGID,.DGPARAM)
65 ;
66 ;; ===================================================================
67 ;; The current HL7 package does not process acknowledgements other than
68 ;; "accepted" through the process routine at the current time. This line
69 ;; should be removed once the HL7 package is patched to process AR and AE messages.
70 ;S:ACK="AA" DGPARAM(4)="" ;changed p-354
71 ;; ===================================================================
72 ;
73 ; Retrieve rejection message from COTS acknowledgement message
74 S:'(ACK="AA") DGPARAM(4)=$P(DGMSG,"^",4)
75 S ^TMP("DGRUACK",$H,"ACK")=DGPARAM(4)
76 Q
77 ;
78EXTRACT(MSGID,DGPARAM) ; Extract patient and related message information for
79 ; error bulletin to be sent
80 ;
81 N DGIEN,DGOIEN,DGQUIT,DGTXT,NDX
82 ;
83 S DGIEN=0
84 ; Retrieve ien of outgoing message administration entry, file #773
85 F S DGIEN=+$O(^HLMA("C",MSGID,DGIEN)) Q:'DGIEN D Q:$G(DGQUIT)
86 . ; Retrieve ien of outgoing message text
87 . S DGOIEN=+$$GET1^DIQ(773,DGIEN,.01,"I")
88 . S DGPARAM(7)=$$GET1^DIQ(773,DGIEN,16,"E") ;changed p-419
89 . S DGPARAM(5)=$$GET1^DIQ(773,DGIEN,2,"I") ;added p-354
90 . Q:(DGOIEN<0)
91 . ; Retrieve information from message file
92 . ;S DGPARAM(5)=+$$GET1^DIQ(772,DGOIEN,6) ;changed p-354
93 . S X=$$GET1^DIQ(772,DGOIEN,200,"","DGTXT")
94 . I $D(DGTXT) D
95 .. S NDX=0
96 .. F S NDX=$O(DGTXT(NDX)) Q:'NDX D
97 ... I $P(DGTXT(NDX),"^")="PID" D
98 .... S DGPARAM(1)=$$FMNAME^HLFNC($P(DGTXT(NDX),"^",6),"~")
99 .... S DGPARAM(2)=$P(DGTXT(NDX),"^",20)
100 ... I $P(DGTXT(NDX),"^")="EVN" D
101 .... S DGPARAM(3)=$P(DGTXT(NDX),"^",2)
102 .... S DGPARAM(6)=$$FMTE^XLFDT($$FMDATE^HLFNC($P(DGTXT(NDX),"^",3)))
103 Q
Note: See TracBrowser for help on using the repository browser.