| [613] | 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 | ;
|
|---|
