MHV7BUS.m

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 ---MHV7BUS   2673     printed  Apr 09, 2024@21:17:49                                                                                                                                                                                                     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      ;