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

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1DGROHLR ;DJH/AMA - ROM HL7 RECEIVE DRIVERS ; 09 Jul 2003 4:41 PM
2 ;;5.3;Registration;**533,572**;Aug 13, 1993
3 ;
4RCV ;Receive all message types and route to message specific receiver
5 ;
6 ;This procedure is the main driver entry point for receiving all
7 ;message types (ACK, QRY and ORF) for Register Once Messaging.
8 ;
9 ;All procedures and functions assume that all VistA HL7 environment
10 ;variables are properly initialized and will produce a fatal error if
11 ;they are missing.
12 ;
13 ;The received message is copied to a temporary work global for
14 ;processing. The message type is determined from the MSH segment and
15 ;a receive processing procedure specific to the message type is called.
16 ;(Ex. ORF~R01 message calls procedure: RCVORF). The specific receive
17 ;processing procedure calls a message specific parse procedure to
18 ;validate the message data and return data arrays for storage. If no
19 ;parse errors are reported during validation, then the data arrays are
20 ;stored by the receive processing procedure. Control, along with any
21 ;parse validation errors, is then passed to the message specific send
22 ;processing procedures to build and transmit the acknowledgment and
23 ;query results messages.
24 ;
25 ; The message specific procedures are as follows:
26 ;
27 ; Message Receive Procedure Parse Procedure Send Procedure
28 ; ------- ----------------- ---------------- --------------
29 ; SNDACK^DGROHLS
30 ; ACK~R01 RCVACK^DGROHLR PARSACK^DGROHLU4 N/A
31 ; QRY~R02 RCVQRY^DGROHLR PARSQRY^DGROHLQ3 SNDORF^DGROHLS
32 ; ORF~R01 RCVORF^DGROHLR PARSORF^DGROHLQ3 N/A
33 ;
34 N DGCNT,DGMSGTYP,DGSEG,DGSEGCNT,DGWRK
35 ;
36 S DGWRK=$NA(^TMP("DGROHL7",$J))
37 K @DGWRK
38 ;
39 ;load work global with segments
40 F DGSEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
41 . S DGCNT=0
42 . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE
43 . F S DGCNT=$O(HLNODE(DGCNT)) Q:'DGCNT D
44 . . S @DGWRK@(DGSEGCNT,DGCNT)=HLNODE(DGCNT)
45 ;
46 ;get message type from "MSH"
47 I $$NXTSEG^DGROHLUT(DGWRK,0,HL("FS"),.DGSEG),$G(DGSEG("TYPE"))="MSH" D
48 . S DGMSGTYP=$P(DGSEG(9),$E(HL("ECH"),1),1)
49 . ;HLMTIENS is only required by RCVORU and RCVQRY, thus $GET
50 . I DGMSGTYP="" S (DGMSGTYP,HL("MTN"))="ORF",HLMTIENS=HLMTIEN
51 . I DGMSGTYP=HL("MTN") D @("RCV"_DGMSGTYP_"(DGWRK,$G(HLMTIENS),.HL)")
52 ;
53 ;cleanup
54 K @DGWRK
55 Q
56 ;
57RCVACK(DGWRK,DGMIEN,DGHL) ;Receive ACK Message Types (ACK~R01)
58 ;
59 ; Input:
60 ; DGWRK - name of work global containing segments
61 ; DGMIEN - IEN of message entry in file #773
62 ; DGHL - HL environment array
63 ;
64 ; Output:
65 ; none
66 ;
67 N DGACK ;ACK data array
68 N DGERR ;error array
69 N DGLIEN ;HL7 transmission log IEN
70 N DGROL ;HL7 transmssion log data array
71 ;
72 S ACKCODE=0
73 D PARSACK^DGROHLU4(DGWRK,.DGHL,.DGACK,.DGERR)
74 I $G(DGACK("ACKCODE"))'="AA" S ACKCODE=1
75 Q
76 ;
77RCVQRY(DGWRK,DGMIEN,DGHL) ;Receive QRY Message Types (QRY~R02)
78 ;
79 ; Input:
80 ; DGWRK - name of work global containing segments
81 ; DGMIEN - IEN of message entry in file #773
82 ; DGHL - HL environment array
83 ;
84 ; Output:
85 ; none
86 ;
87 N DGDFN,DGQRY,DGQRYERR,DGSEGERR
88 ;
89 D PARSQRY^DGROHLQ3(DGWRK,.DGHL,.DGQRY,.DGSEGERR)
90 S DGDFN=$$GETDFN^DGROUT2(DGQRY("ICN"),DGQRY("DOB"),DGQRY("SSN"))
91 I DGDFN'>0 D
92 . S DGQRYERR="NM"
93 . ;
94 . ;THE ICN FROM THE MPI DOES NOT MATCH A PATIENT, SO NOTIFY THE MPI
95 . D MPIMAIL^DGROMAIL(.DGQRY)
96 . ;
97 D SNDORF^DGROHLS(.DGQRY,DGMIEN,.DGHL,DGDFN,.DGSEGERR,.DGQRYERR)
98 Q
99 ;
100RCVORF(DGWRK,DGMIEN,DGHL) ;Receive ORF Message Types (ORF~R01)
101 ;
102 ; Input:
103 ; DGWRK - name of work global containing segments, ^TMP("DGROHL7",$J)
104 ; DGMIEN - IEN of message entry in file #773
105 ; DGHL - HL environment array
106 ;
107 ; Output:
108 ; none
109 ;
110 N DGDATA ;patient data array to upload
111 N DGERR ;parse error array
112 N DGORF ;ORF data array
113 ;
114 S DGDATA=$NA(^TMP("DGROFDA",$J)) K @DGDATA
115 D PARSORF^DGROHLQ3(DGWRK,.DGHL,.DGORF,.DGERR,.DGDATA)
116 ;
117 I $D(DGROVRCK) DO
118 . S:('$D(DGORF("PATCH"))) DGROVRCK=0
119 . I ($D(DGORF("PATCH"))),(+DGORF("PATCH")'=572) S DGROVRCK=0
120 ;
121 ;* QUIT conditions
122 Q:'$D(DGORF)
123 Q:(+$G(DGORF("DFN"))'>0)
124 Q:'$D(^DPT(DGORF("DFN"),0))
125 Q:('$D(DGORF("PATCH")))
126 Q:(+DGORF("PATCH")'=572)
127 ;
128 S DFN=DGORF("DFN")
129 ;
130 ;Get DFN at Last Site Treated
131 S LSTDFN=+$O(@DGDATA@(2,""))
132 ;CHECK BUSINESS RULES
133 D POW^DGRODEBR(DGDATA,DFN,LSTDFN) ;POW STATUS
134 D AO^DGRODEBR(DGDATA,DFN,LSTDFN) ;AGENT ORANGE EXPOSURE
135 D IR^DGRODEBR(DGDATA,DFN,LSTDFN) ;RADIATION EXPOSURE
136 D DOD^DGRODEBR(DGDATA,DFN,LSTDFN) ;DATE OF DEATH
137 D TA^DGRODEBR(DGDATA,LSTDFN) ;TEMPORARY ADDRESS
138 D SP^DGRODEBR(DGDATA,DFN,LSTDFN) ;SENSITIVE PATIENT
139 D CA^DGRODEBR(DGDATA,LSTDFN) ;CONFIDENTIAL ADDRESS
140 D PA^DGRODEBR(DGDATA,LSTDFN) ;PERMANENT ADDRESS
141 ;
142 ;File the data
143 D CONVFDA^DGROHLR1(DFN,DGDATA)
144 ;CLEAN UP
145 K @DGDATA
146 Q
Note: See TracBrowser for help on using the repository browser.