source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B1.m@ 901

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

revised back to 6/30/08 version

File size: 3.2 KB
Line 
1MHV7B1 ;WAS/GPM - HL7 message builder RTB^K13 ; [8/22/05 6:18pm]
2 ;;1.0;My HealtheVet;;Aug 23, 2005
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7RTBK13(MSGROOT,QRY,ERR,DATAROOT,HL) ; Build query response
8 ;
9 ; Populates the array pointed to by MSGROOT with an RTB^K13 query
10 ; response message by calling the appropriate segment builders based
11 ; on the type of response ACK/Data or NAK. Extracted data pointed to
12 ; by DATAROOT, errors, hit counts, and query information are user to
13 ; buld the segments.
14 ; An error number in ERR^4 indicates a NAK is needed.
15 ; DATAROOT being null indicates a dataless ACK (testing purposes).
16 ; Multiple types of RDF/RDT are supported based on the type of
17 ; data in the response, indicated by QRY("TYPE").
18 ;
19 ; Input:
20 ; MSGROOT - Global root of message
21 ; QRY - Query parameters
22 ; QRY("TYPE") - Request type number
23 ; QRY("MID") - original message control ID
24 ; ERR - Caret delimited error string
25 ; segment^sequence^field^code^ACK type^error text
26 ; DATAROOT - Global root of data array
27 ; HL - HL7 package array variable
28 ;
29 ; Output: RTB^K13 message in MSGROOT
30 ;
31 N CNT,RDT,HIT
32 S HIT=""
33 I DATAROOT'="" S HIT=$G(@DATAROOT)
34 I HIT="" S HIT=0
35 S HIT=HIT_"^"_HIT_"^0"
36 K @MSGROOT
37 S CNT=1,@MSGROOT@(CNT)=$$MSA($G(QRY("MID")),ERR,.HL)
38 I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR(ERR,.HL)
39 S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK(.QRY,ERR,HIT,.HL)
40 S CNT=CNT+1,@MSGROOT@(CNT)=$$QPD(.QRY,.HL)
41 Q:$P(ERR,"^",4)
42 S CNT=CNT+1,@MSGROOT@(CNT)=$$RDF(QRY("TYPE"),.HL)
43 Q:DATAROOT=""
44 Q:@DATAROOT<1
45 D RDT(MSGROOT,QRY("TYPE"),DATAROOT,.CNT,.HL)
46 Q
47 ;
48MSA(MID,ERROR,HL) ;build MSA segment
49 N MSA,ACK
50 S ACK=$P(ERROR,"^",5)
51 I ACK="" S ACK="AA"
52 S MSA(0)="MSA"
53 S MSA(1)=ACK ;ACK code
54 S MSA(2)=MID ;message control ID
55 S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message
56 Q $$BLDSEG^MHV7U(.MSA,.HL)
57 ;
58ERR(ERROR,HL) ;build ERR segment
59 N ERR
60 S ERR(0)="ERR"
61 S ERR(1,1,1)=$P(ERROR,"^",1) ;segment
62 S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence
63 S ERR(1,1,3)=$P(ERROR,"^",3) ;field
64 S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code
65 S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text
66 Q $$BLDSEG^MHV7U(.ERR,.HL)
67 ;
68QAK(QRY,ERROR,HIT,HL) ;build QAK segment
69 N QAK,STATUS
70 S STATUS=$P(ERROR,"^",5)
71 I STATUS="" S STATUS="OK"
72 I STATUS="OK",HIT<1 S STATUS="NF"
73 S QAK(0)="QAK"
74 S QAK(1)=QRY("QPD",2) ;query tag
75 S QAK(2)=STATUS ;query response status
76 M QAK(3)=QRY("QPD",1) ;message query name
77 S QAK(4)=$P(HIT,"^",1) ;hit count total
78 S QAK(5)=$P(HIT,"^",2) ;hits this payload
79 S QAK(6)=$P(HIT,"^",3) ;hits remaining
80 Q $$BLDSEG^MHV7U(.QAK,.HL)
81 ;
82QPD(QRY,HL) ;build QPD segment
83 N QPD
84 M QPD=QRY("QPD")
85 S QPD(0)="QPD"
86 S QPD(7)=$G(QRY("ICN")) ;ICN
87 S QPD(8)=$G(QRY("DFN")) ;DFN
88 Q $$BLDSEG^MHV7U(.QPD,.HL)
89 ;
90RDF(REQTYPE,HL) ; build RDF segment
91 N RTN
92 S RTN=$$RTN(REQTYPE)
93 Q:RTN="" "RDF"
94 Q @("$$RDF^"_RTN_"(.HL)")
95 ;
96RDT(MSGROOT,REQTYPE,DATAROOT,CNT,HL) ; Build RDT segments
97 N RTN
98 S RTN=$$RTN(REQTYPE)
99 Q:RTN=""
100 D @("RDT^"_RTN_"(MSGROOT,DATAROOT,.CNT,.HL)")
101 Q
102 ;
103RTN(REQTYPE) ;
104 N RDEF
105 S RDEF(3)="MHV7B1B"
106 S RDEF(21)="MHV7B1B"
107 Q $G(RDEF(REQTYPE))
108 ;
Note: See TracBrowser for help on using the repository browser.