- 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 Feb 18, 2025@23:42:03 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 ;
