MHV7BUS ;WAS/GPM - HL7 BUILDER UTILITIES - SEGMENTS ; 1/21/08 8:28pm
;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Segment builders common to multiple messages.
; Message builders with message specific segments will contain
; those message specific segment builders. Examples would be the
; RDF for RTB^K13 messages or the PID for the ADR^A19.
;
Q
;
MSA(MID,ERROR,HL) ;build MSA segment
N MSA,ACK
S ACK=$P(ERROR,"^",5)
I ACK="" S ACK="AA"
S MSA(0)="MSA"
S MSA(1)=ACK ;ACK code
S MSA(2)=MID ;message control ID
S MSA(3)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text message
Q $$BLDSEG^MHV7U(.MSA,.HL)
;
ERR(ERROR,HL) ;build ERR segment
N ERR
S ERR(0)="ERR"
S ERR(1,1,1)=$P(ERROR,"^",1) ;segment
S ERR(1,1,2)=$P(ERROR,"^",2) ;sequence
S ERR(1,1,3)=$P(ERROR,"^",3) ;field
S ERR(1,1,4,1)=$P(ERROR,"^",4) ;code
S ERR(1,1,4,2)=$$ESCAPE^MHV7U($P(ERROR,"^",6),.HL) ;text
Q $$BLDSEG^MHV7U(.ERR,.HL)
;
QAK(QRY,ERROR,HIT,HL) ;build QAK segment
N QAK,STATUS
S STATUS=$P(ERROR,"^",5)
I STATUS="" S STATUS="OK"
I STATUS="OK",HIT<1 S STATUS="NF"
S QAK(0)="QAK"
I $D(QRY("QPD")) D ;QBP style query
. S QAK(1)=$G(QRY("QPD",2)) ;query tag
. M QAK(3)=QRY("QPD",1) ;message query name
. Q
I $D(QRY("QRD")) D ;old style query
. S QAK(1)=$G(QRY("QRD",4)) ;query tag
. M QAK(3)=QRY("QRD",9) ;message query name
. S QAK(3,1,2)=$G(QRY("QRD",10))
. Q
S QAK(2)=STATUS ;query response status
S QAK(4)=$P(HIT,"^",1) ;hit count total
S QAK(5)=$P(HIT,"^",2) ;hits this payload
S QAK(6)=$P(HIT,"^",3) ;hits remaining
Q $$BLDSEG^MHV7U(.QAK,.HL)
;
QPD(QRY,EXTIME,HL) ;build QPD segment
N QPD
M QPD=QRY("QPD")
S QPD(0)="QPD"
S QPD(7)=$G(QRY("ICN")) ;ICN
S QPD(8)=$G(QRY("DFN")) ;DFN
S QPD(9)=$$FMTHL7^MHV7BU(EXTIME) ;Extract time
Q $$BLDSEG^MHV7U(.QPD,.HL)
;
QRD(QRY,EXTIME,HL) ; Build QRD segment
N QRD
M QRD=QRY("QRD")
S QRD(0)="QRD"
S QRD(1)=$$FMTHL7^MHV7BU(EXTIME) ;Extract time
Q $$BLDSEG^MHV7U(.QRD,.HL)
;
QRF(QRY,HL) ; Build QRF segment
N QRF
M QRF=QRY("QRF")
S QRF(0)="QRF"
Q $$BLDSEG^MHV7U(.QRF,.HL)
;
PID(QRY,HL) ; Build basic PID segment
N PID,NAME,ICN,DFN,SSN
S ICN=$G(QRY("ICN"))
S DFN=$G(QRY("DFN"))
S SSN=$G(QRY("SSN"))
S PID(0)="PID"
D PID3^MHV7BU(.PID,ICN,DFN,SSN) ;ID list
D FMTNAME2^MHV7BU(DFN,2,.NAME,.HL,"XPN")
M PID(5,1)=NAME
Q $$BLDSEG^MHV7U(.PID,.HL)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7BUS 2673 printed Oct 16, 2024@18:16:36 Page 2
MHV7BUS ;WAS/GPM - HL7 BUILDER UTILITIES - SEGMENTS ; 1/21/08 8:28pm
+1 ;;1.0;My HealtheVet;**2**;Aug 23, 2005;Build 22
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Segment builders common to multiple messages.
+5 ; Message builders with message specific segments will contain
+6 ; those message specific segment builders. Examples would be the
+7 ; RDF for RTB^K13 messages or the PID for the ADR^A19.
+8 ;
+9 QUIT
+10 ;
MSA(MID,ERROR,HL) ;build MSA segment
+1 NEW MSA,ACK
+2 SET ACK=$PIECE(ERROR,"^",5)
+3 IF ACK=""
SET ACK="AA"
+4 SET MSA(0)="MSA"
+5 ;ACK code
SET MSA(1)=ACK
+6 ;message control ID
SET MSA(2)=MID
+7 ;text message
SET MSA(3)=$$ESCAPE^MHV7U($PIECE(ERROR,"^",6),.HL)
+8 QUIT $$BLDSEG^MHV7U(.MSA,.HL)
+9 ;
ERR(ERROR,HL) ;build ERR segment
+1 NEW ERR
+2 SET ERR(0)="ERR"
+3 ;segment
SET ERR(1,1,1)=$PIECE(ERROR,"^",1)
+4 ;sequence
SET ERR(1,1,2)=$PIECE(ERROR,"^",2)
+5 ;field
SET ERR(1,1,3)=$PIECE(ERROR,"^",3)
+6 ;code
SET ERR(1,1,4,1)=$PIECE(ERROR,"^",4)
+7 ;text
SET ERR(1,1,4,2)=$$ESCAPE^MHV7U($PIECE(ERROR,"^",6),.HL)
+8 QUIT $$BLDSEG^MHV7U(.ERR,.HL)
+9 ;
QAK(QRY,ERROR,HIT,HL) ;build QAK segment
+1 NEW QAK,STATUS
+2 SET STATUS=$PIECE(ERROR,"^",5)
+3 IF STATUS=""
SET STATUS="OK"
+4 IF STATUS="OK"
IF HIT<1
SET STATUS="NF"
+5 SET QAK(0)="QAK"
+6 ;QBP style query
IF $DATA(QRY("QPD"))
Begin DoDot:1
+7 ;query tag
SET QAK(1)=$GET(QRY("QPD",2))
+8 ;message query name
MERGE QAK(3)=QRY("QPD",1)
+9 QUIT
End DoDot:1
+10 ;old style query
IF $DATA(QRY("QRD"))
Begin DoDot:1
+11 ;query tag
SET QAK(1)=$GET(QRY("QRD",4))
+12 ;message query name
MERGE QAK(3)=QRY("QRD",9)
+13 SET QAK(3,1,2)=$GET(QRY("QRD",10))
+14 QUIT
End DoDot:1
+15 ;query response status
SET QAK(2)=STATUS
+16 ;hit count total
SET QAK(4)=$PIECE(HIT,"^",1)
+17 ;hits this payload
SET QAK(5)=$PIECE(HIT,"^",2)
+18 ;hits remaining
SET QAK(6)=$PIECE(HIT,"^",3)
+19 QUIT $$BLDSEG^MHV7U(.QAK,.HL)
+20 ;
QPD(QRY,EXTIME,HL) ;build QPD segment
+1 NEW QPD
+2 MERGE QPD=QRY("QPD")
+3 SET QPD(0)="QPD"
+4 ;ICN
SET QPD(7)=$GET(QRY("ICN"))
+5 ;DFN
SET QPD(8)=$GET(QRY("DFN"))
+6 ;Extract time
SET QPD(9)=$$FMTHL7^MHV7BU(EXTIME)
+7 QUIT $$BLDSEG^MHV7U(.QPD,.HL)
+8 ;
QRD(QRY,EXTIME,HL) ; Build QRD segment
+1 NEW QRD
+2 MERGE QRD=QRY("QRD")
+3 SET QRD(0)="QRD"
+4 ;Extract time
SET QRD(1)=$$FMTHL7^MHV7BU(EXTIME)
+5 QUIT $$BLDSEG^MHV7U(.QRD,.HL)
+6 ;
QRF(QRY,HL) ; Build QRF segment
+1 NEW QRF
+2 MERGE QRF=QRY("QRF")
+3 SET QRF(0)="QRF"
+4 QUIT $$BLDSEG^MHV7U(.QRF,.HL)
+5 ;
PID(QRY,HL) ; Build basic PID segment
+1 NEW PID,NAME,ICN,DFN,SSN
+2 SET ICN=$GET(QRY("ICN"))
+3 SET DFN=$GET(QRY("DFN"))
+4 SET SSN=$GET(QRY("SSN"))
+5 SET PID(0)="PID"
+6 ;ID list
DO PID3^MHV7BU(.PID,ICN,DFN,SSN)
+7 DO FMTNAME2^MHV7BU(DFN,2,.NAME,.HL,"XPN")
+8 MERGE PID(5,1)=NAME
+9 QUIT $$BLDSEG^MHV7U(.PID,.HL)
+10 ;
