MHV7B8 ;WAS/GPM - HL7 message builder SECURE MESSAGING ADR^A19 ; [3/23/08 8:18pm]
;;1.0;My HealtheVet;**5**;Aug 23, 2005;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
ADRA19(MSGROOT,QRY,ERR,DATAROOT,LEN,HL) ; Build query response
;
; Populates the array pointed to by MSGROOT with an ADR^A19 query
; response message by calling the appropriate segment builders based
; on the type of response ACK/Data or NAK. Extracted data pointed to
; by DATAROOT, errors, hit counts, and query information are used to
; build the segments.
; An error number in ERR^4 indicates a NAK is needed.
; DATAROOT being null indicates a dataless ACK (testing purposes).
;
; Input:
; MSGROOT - Global root of message
; QRY - Query parameters
; QRY("MID") - original message control ID
; ERR - Caret delimited error string
; segment^sequence^field^code^ACK type^error text
; DATAROOT - Global root of data array
; HL - HL7 package array variable
;
; Output: ADR^A19 message in MSGROOT
; LEN - Length of formatted message
;
N CNT,HIT,EXTIME
D LOG^MHVUL2("SM ADR-A19 BUILDER","BEGIN","S","TRACE")
;
S HIT=0,EXTIME=""
I DATAROOT'="" D
. S HIT=+$P($G(@DATAROOT),"^",1)
. S EXTIME=$P($G(@DATAROOT),"^",2)
. Q
S HIT=HIT_"^"_HIT_"^0"
;
K @MSGROOT
S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7BUS($G(QRY("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT))
I $P(ERR,"^",4) S CNT=CNT+1,HIT="0^0^0",@MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
S CNT=CNT+1,@MSGROOT@(CNT)=$$QRD^MHV7BUS(.QRY,EXTIME,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
S CNT=CNT+1,@MSGROOT@(CNT)=$$QRF^MHV7BUS(.QRY,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^MHV7BUS(.QRY,ERR,HIT,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$PID^MHV7BUS(.QRY,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
;
I '$P(ERR,"^",4),HIT>0,DATAROOT'="" D
. S CNT=CNT+1,@MSGROOT@(CNT)=$$PID(.QRY,DATAROOT,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
. S CNT=CNT+1,@MSGROOT@(CNT)=$$PD1(DATAROOT,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
. S CNT=CNT+1,@MSGROOT@(CNT)=$$PV1(DATAROOT,.HL),LEN=LEN+$L(@MSGROOT@(CNT))
. Q
;
D LOG^MHVUL2("SM ADR-A19 BUILDER","END","S","TRACE")
Q
;
PID(QRY,DATAROOT,HL) ;
N PID,T,X,NAME
S PID(0)="PID"
;
;Build PID(3)
D PID3^MHV7BU(.PID,QRY("ICN"),QRY("DFN"),QRY("SSN"))
;
;Build PID(5)
D FMTNAME2^MHV7BU(QRY("DFN"),2,.NAME,.HL,"XPN")
M PID(5,1)=NAME
;
S PID(7,1,1)=$$FMTHL7^XLFDT(@DATAROOT@("DOB"))
S PID(8)=$$ESCAPE^MHV7U(@DATAROOT@("SEX"),.HL)
S PID(11,1,1,1)=$$ESCAPE^MHV7U(@DATAROOT@("ADD1"),.HL)
S X=@DATAROOT@("ADD2")
S T=@DATAROOT@("ADD3")
I $L(X)&$L(T) S X=X_" "
S PID(11,1,2)=$$ESCAPE^MHV7U(X_T,.HL)
S PID(11,1,3)=$$ESCAPE^MHV7U(@DATAROOT@("CITY"),.HL)
S PID(11,1,4)=$$ESCAPE^MHV7U(@DATAROOT@("STATE"),.HL)
S PID(11,1,5)=$$ESCAPE^MHV7U(@DATAROOT@("ZIP"),.HL)
S PID(11,1,7)="M" ;address type
S PID(11,1,9)=$$ESCAPE^MHV7U(@DATAROOT@("COUNTY"),.HL)
S PID(13,1,1)=$$HLPHONE^HLFNC(@DATAROOT@("PHONE"))
S PID(13,1,4)=$$ESCAPE^MHV7U(@DATAROOT@("E-MAIL"),.HL)
S PID(14,1,1)=$$HLPHONE^HLFNC(@DATAROOT@("BUS-PHONE"))
S PID(16,1,2)=$$ESCAPE^MHV7U(@DATAROOT@("MARITAL-STATUS"),.HL)
S PID(17,1,2)=$$ESCAPE^MHV7U(@DATAROOT@("RELIGION"),.HL)
S X=@DATAROOT@("BIRTH-CITY")_"^"_@DATAROOT@("BIRTH-STATE")
S PID(23)=$$ESCAPE^MHV7U(X,.HL) ;birth place
S PID(29,1,1)=$$FMTHL7^XLFDT(@DATAROOT@("DOD"))
Q $$BLDSEG^MHV7U(.PID,.HL)
;
PV1(DATAROOT,HL) ;
N PV1,NAME,DOC
S PV1(0)="PV1"
S PV1(2)="N" ;Patient class
S DOC=@DATAROOT@("ATTENDING-PHYSICIAN")
D FMTNAME^MHV7BU(DOC,.NAME,.HL,"XCN")
M PV1(7,1)=NAME
Q $$BLDSEG^MHV7U(.PV1,.HL)
;
PD1(DATAROOT,HL) ;
N PD1,NAME,DOC
S PD1(0)="PD1"
S DOC=@DATAROOT@("PRIMARY-CARE-PHYSICIAN")
D FMTNAME^MHV7BU(DOC,.NAME,.HL,"XCN")
M PD1(4,1)=NAME
Q $$BLDSEG^MHV7U(.PD1,.HL)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV7B8 3997 printed Apr 09, 2024@21:17:28 Page 2
MHV7B8 ;WAS/GPM - HL7 message builder SECURE MESSAGING ADR^A19 ; [3/23/08 8:18pm]
+1 ;;1.0;My HealtheVet;**5**;Aug 23, 2005;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
ADRA19(MSGROOT,QRY,ERR,DATAROOT,LEN,HL) ; Build query response
+1 ;
+2 ; Populates the array pointed to by MSGROOT with an ADR^A19 query
+3 ; response message by calling the appropriate segment builders based
+4 ; on the type of response ACK/Data or NAK. Extracted data pointed to
+5 ; by DATAROOT, errors, hit counts, and query information are used to
+6 ; build the segments.
+7 ; An error number in ERR^4 indicates a NAK is needed.
+8 ; DATAROOT being null indicates a dataless ACK (testing purposes).
+9 ;
+10 ; Input:
+11 ; MSGROOT - Global root of message
+12 ; QRY - Query parameters
+13 ; QRY("MID") - original message control ID
+14 ; ERR - Caret delimited error string
+15 ; segment^sequence^field^code^ACK type^error text
+16 ; DATAROOT - Global root of data array
+17 ; HL - HL7 package array variable
+18 ;
+19 ; Output: ADR^A19 message in MSGROOT
+20 ; LEN - Length of formatted message
+21 ;
+22 NEW CNT,HIT,EXTIME
+23 DO LOG^MHVUL2("SM ADR-A19 BUILDER","BEGIN","S","TRACE")
+24 ;
+25 SET HIT=0
SET EXTIME=""
+26 IF DATAROOT'=""
Begin DoDot:1
+27 SET HIT=+$PIECE($GET(@DATAROOT),"^",1)
+28 SET EXTIME=$PIECE($GET(@DATAROOT),"^",2)
+29 QUIT
End DoDot:1
+30 SET HIT=HIT_"^"_HIT_"^0"
+31 ;
+32 KILL @MSGROOT
+33 SET CNT=1
SET @MSGROOT@(CNT)=$$MSA^MHV7BUS($GET(QRY("MID")),ERR,.HL)
SET LEN=$LENGTH(@MSGROOT@(CNT))
+34 IF $PIECE(ERR,"^",4)
SET CNT=CNT+1
SET HIT="0^0^0"
SET @MSGROOT@(CNT)=$$ERR^MHV7BUS(ERR,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+35 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$QRD^MHV7BUS(.QRY,EXTIME,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+36 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$QRF^MHV7BUS(.QRY,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+37 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$QAK^MHV7BUS(.QRY,ERR,HIT,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+38 IF $PIECE(ERR,"^",4)
SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$PID^MHV7BUS(.QRY,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+39 ;
+40 IF '$PIECE(ERR,"^",4)
IF HIT>0
IF DATAROOT'=""
Begin DoDot:1
+41 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$PID(.QRY,DATAROOT,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+42 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$PD1(DATAROOT,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+43 SET CNT=CNT+1
SET @MSGROOT@(CNT)=$$PV1(DATAROOT,.HL)
SET LEN=LEN+$LENGTH(@MSGROOT@(CNT))
+44 QUIT
End DoDot:1
+45 ;
+46 DO LOG^MHVUL2("SM ADR-A19 BUILDER","END","S","TRACE")
+47 QUIT
+48 ;
PID(QRY,DATAROOT,HL) ;
+1 NEW PID,T,X,NAME
+2 SET PID(0)="PID"
+3 ;
+4 ;Build PID(3)
+5 DO PID3^MHV7BU(.PID,QRY("ICN"),QRY("DFN"),QRY("SSN"))
+6 ;
+7 ;Build PID(5)
+8 DO FMTNAME2^MHV7BU(QRY("DFN"),2,.NAME,.HL,"XPN")
+9 MERGE PID(5,1)=NAME
+10 ;
+11 SET PID(7,1,1)=$$FMTHL7^XLFDT(@DATAROOT@("DOB"))
+12 SET PID(8)=$$ESCAPE^MHV7U(@DATAROOT@("SEX"),.HL)
+13 SET PID(11,1,1,1)=$$ESCAPE^MHV7U(@DATAROOT@("ADD1"),.HL)
+14 SET X=@DATAROOT@("ADD2")
+15 SET T=@DATAROOT@("ADD3")
+16 IF $LENGTH(X)&$LENGTH(T)
SET X=X_" "
+17 SET PID(11,1,2)=$$ESCAPE^MHV7U(X_T,.HL)
+18 SET PID(11,1,3)=$$ESCAPE^MHV7U(@DATAROOT@("CITY"),.HL)
+19 SET PID(11,1,4)=$$ESCAPE^MHV7U(@DATAROOT@("STATE"),.HL)
+20 SET PID(11,1,5)=$$ESCAPE^MHV7U(@DATAROOT@("ZIP"),.HL)
+21 ;address type
SET PID(11,1,7)="M"
+22 SET PID(11,1,9)=$$ESCAPE^MHV7U(@DATAROOT@("COUNTY"),.HL)
+23 SET PID(13,1,1)=$$HLPHONE^HLFNC(@DATAROOT@("PHONE"))
+24 SET PID(13,1,4)=$$ESCAPE^MHV7U(@DATAROOT@("E-MAIL"),.HL)
+25 SET PID(14,1,1)=$$HLPHONE^HLFNC(@DATAROOT@("BUS-PHONE"))
+26 SET PID(16,1,2)=$$ESCAPE^MHV7U(@DATAROOT@("MARITAL-STATUS"),.HL)
+27 SET PID(17,1,2)=$$ESCAPE^MHV7U(@DATAROOT@("RELIGION"),.HL)
+28 SET X=@DATAROOT@("BIRTH-CITY")_"^"_@DATAROOT@("BIRTH-STATE")
+29 ;birth place
SET PID(23)=$$ESCAPE^MHV7U(X,.HL)
+30 SET PID(29,1,1)=$$FMTHL7^XLFDT(@DATAROOT@("DOD"))
+31 QUIT $$BLDSEG^MHV7U(.PID,.HL)
+32 ;
PV1(DATAROOT,HL) ;
+1 NEW PV1,NAME,DOC
+2 SET PV1(0)="PV1"
+3 ;Patient class
SET PV1(2)="N"
+4 SET DOC=@DATAROOT@("ATTENDING-PHYSICIAN")
+5 DO FMTNAME^MHV7BU(DOC,.NAME,.HL,"XCN")
+6 MERGE PV1(7,1)=NAME
+7 QUIT $$BLDSEG^MHV7U(.PV1,.HL)
+8 ;
PD1(DATAROOT,HL) ;
+1 NEW PD1,NAME,DOC
+2 SET PD1(0)="PD1"
+3 SET DOC=@DATAROOT@("PRIMARY-CARE-PHYSICIAN")
+4 DO FMTNAME^MHV7BU(DOC,.NAME,.HL,"XCN")
+5 MERGE PD1(4,1)=NAME
+6 QUIT $$BLDSEG^MHV7U(.PD1,.HL)
+7 ;
