1 | MHV7BUS ;WAS/GPM - HL7 BUILDER UTILITIES - SEGMENTS ; 1/21/08 8:28pm
|
---|
2 | ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; Segment builders common to multiple messages.
|
---|
6 | ; Message builders with message specific segments will contain
|
---|
7 | ; those message specific segment builders. Examples would be the
|
---|
8 | ; RDF for RTB^K13 messages or the PID for the ADR^A19.
|
---|
9 | ;
|
---|
10 | Q
|
---|
11 | ;
|
---|
12 | MSA(MID,ERROR,HL) ;build MSA segment
|
---|
13 | N MSA,ACK
|
---|
14 | S ACK=$P(ERROR,"^",5)
|
---|
15 | I ACK="" S ACK="AA"
|
---|
16 | S MSA(0)="MSA"
|
---|
17 | S MSA(1)=ACK ;ACK code
|
---|
18 | S MSA(2)=MID ;message control ID
|
---|
19 | S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message
|
---|
20 | Q $$BLDSEG^MHV7U(.MSA,.HL)
|
---|
21 | ;
|
---|
22 | ERR(ERROR,HL) ;build ERR segment
|
---|
23 | N ERR
|
---|
24 | S ERR(0)="ERR"
|
---|
25 | S ERR(1,1,1)=$P(ERROR,"^",1) ;segment
|
---|
26 | S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence
|
---|
27 | S ERR(1,1,3)=$P(ERROR,"^",3) ;field
|
---|
28 | S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code
|
---|
29 | S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text
|
---|
30 | Q $$BLDSEG^MHV7U(.ERR,.HL)
|
---|
31 | ;
|
---|
32 | QAK(QRY,ERROR,HIT,HL) ;build QAK segment
|
---|
33 | N QAK,STATUS
|
---|
34 | S STATUS=$P(ERROR,"^",5)
|
---|
35 | I STATUS="" S STATUS="OK"
|
---|
36 | I STATUS="OK",HIT<1 S STATUS="NF"
|
---|
37 | S QAK(0)="QAK"
|
---|
38 | I $D(QRY("QPD")) D ;QBP style query
|
---|
39 | . S QAK(1)=$G(QRY("QPD",2)) ;query tag
|
---|
40 | . M QAK(3)=QRY("QPD",1) ;message query name
|
---|
41 | . Q
|
---|
42 | I $D(QRY("QRD")) D ;old style query
|
---|
43 | . S QAK(1)=$G(QRY("QRD",4)) ;query tag
|
---|
44 | . M QAK(3)=QRY("QRD",9) ;message query name
|
---|
45 | . S QAK(3,1,2)=$G(QRY("QRD",10))
|
---|
46 | . Q
|
---|
47 | S QAK(2)=STATUS ;query response status
|
---|
48 | S QAK(4)=$P(HIT,"^",1) ;hit count total
|
---|
49 | S QAK(5)=$P(HIT,"^",2) ;hits this payload
|
---|
50 | S QAK(6)=$P(HIT,"^",3) ;hits remaining
|
---|
51 | Q $$BLDSEG^MHV7U(.QAK,.HL)
|
---|
52 | ;
|
---|
53 | QPD(QRY,EXTIME,HL) ;build QPD segment
|
---|
54 | N QPD
|
---|
55 | M QPD=QRY("QPD")
|
---|
56 | S QPD(0)="QPD"
|
---|
57 | S QPD(7)=$G(QRY("ICN")) ;ICN
|
---|
58 | S QPD(8)=$G(QRY("DFN")) ;DFN
|
---|
59 | S QPD(9)=$$FMTHL7^MHV7BU(EXTIME) ;Extract time
|
---|
60 | Q $$BLDSEG^MHV7U(.QPD,.HL)
|
---|
61 | ;
|
---|
62 | QRD(QRY,EXTIME,HL) ; Build QRD segment
|
---|
63 | N QRD
|
---|
64 | M QRD=QRY("QRD")
|
---|
65 | S QRD(0)="QRD"
|
---|
66 | S QRD(1)=$$FMTHL7^MHV7BU(EXTIME) ;Extract time
|
---|
67 | Q $$BLDSEG^MHV7U(.QRD,.HL)
|
---|
68 | ;
|
---|
69 | QRF(QRY,HL) ; Build QRF segment
|
---|
70 | N QRF
|
---|
71 | M QRF=QRY("QRF")
|
---|
72 | S QRF(0)="QRF"
|
---|
73 | Q $$BLDSEG^MHV7U(.QRF,.HL)
|
---|
74 | ;
|
---|
75 | PID(QRY,HL) ; Build basic PID segment
|
---|
76 | N PID,NAME,ICN,DFN,SSN
|
---|
77 | S ICN=$G(QRY("ICN"))
|
---|
78 | S DFN=$G(QRY("DFN"))
|
---|
79 | S SSN=$G(QRY("SSN"))
|
---|
80 | S PID(0)="PID"
|
---|
81 | D PID3^MHV7BU(.PID,ICN,DFN,SSN) ;ID list
|
---|
82 | D FMTNAME2^MHV7BU(DFN,2,.NAME,.HL,"XPN")
|
---|
83 | M PID(5,1)=NAME
|
---|
84 | Q $$BLDSEG^MHV7U(.PID,.HL)
|
---|
85 | ;
|
---|