VAFHQRY ;ALB/RJS - MCCR DATA CAPTURE HANDLES QUERY MESSAGES ; 6/7/95
;;5.3;Registration;**91,415**;Jun 06, 1996
;;HL7v1.6
;
; THIS ROUTINE HANDLES THE QUERY MESSAGES FOR THE HL7 ADT
; PROJECT
;
; INPUT IS THE IEN OF THE MESSAGE IN THE ^HL(772 GLOBAL, "HLDA"
;
; THE ROUTINE PARSES THE MESSAGE AND DETERMINES IF THERE IS A QUERY
; SEGMENT PRESENT. IF SO, THE QUERY IS REQUESTING PATIENT DEMOGRAPHIC
; DATA IN A PID SEGMENT
;
N ERR1,ERR2,ERR3,COMPNENT,SSN,DFN,VAQD
S ERR1="Invalid or missing access code"
S ERR2="Missing QRD Segment"
S ERR3="Could not resolve DFN"
;I $G(HLDUZ)'>0 S HLERR=ERR1 G ACK ;Invalid or missing access code
S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
;
S COMPNENT=$E(HL("ECH")) ;hlech
K VADC,HLERR
;D INITIZE^VAFHUTL9(HLDA) ;QUERY MESSAGE RETURNED IN VADC() ARRAY
D INIT1
S VAQD=$$SEG1^VAFHUTL9("QRD",1,"QRD")
I VAQD="" S HLERR=ERR2 G ACK ;Missing QRD segment
;
PARSE ;
S SSN=$P(VAQD,HLFS,9)
S DFN=$$SSNDFN^VAFHUTL9(SSN)
I DFN'>0 S HLERR=ERR3 G ACK
;
S HLA("HLS",1)="MSA"_HL("FS")_$S(HL:$S(HL("VER")=2.1:"AR",1:"CR"),1:"CA")_HL("FS")_HL("MID")_HL("FS")_$P(HL,"^",2)
S HLA("HLS",2)=VAQD
;
S HLA("HLS",3)=$$EN^VAFHLPID(DFN,",2,3,4,5,6,7,8,9,10B,11,12,13,14,15,16,17,18,19,22B")
;
ACK I $D(HLERR) S HLA("HLS",2)="MSA"_HLFS_"AE"_HLFS_HLMID_HLFS_HLERR G EXIT
;
EXIT S HLDT=$$NOW^XLFDT()
D GENERATE^HLMA("VAFH A19","LM",1,.HLRESLT,"",.HL)
Q
;
INIT1 F I=1:1 X HLNEXT Q:HLQUIT'>0 S X(I)=HLNODE MERGE X(I)=HLNODE
MERGE VADC=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHQRY 1530 printed Dec 13, 2024@03:03:49 Page 2
VAFHQRY ;ALB/RJS - MCCR DATA CAPTURE HANDLES QUERY MESSAGES ; 6/7/95
+1 ;;5.3;Registration;**91,415**;Jun 06, 1996
+2 ;;HL7v1.6
+3 ;
+4 ; THIS ROUTINE HANDLES THE QUERY MESSAGES FOR THE HL7 ADT
+5 ; PROJECT
+6 ;
+7 ; INPUT IS THE IEN OF THE MESSAGE IN THE ^HL(772 GLOBAL, "HLDA"
+8 ;
+9 ; THE ROUTINE PARSES THE MESSAGE AND DETERMINES IF THERE IS A QUERY
+10 ; SEGMENT PRESENT. IF SO, THE QUERY IS REQUESTING PATIENT DEMOGRAPHIC
+11 ; DATA IN A PID SEGMENT
+12 ;
+13 NEW ERR1,ERR2,ERR3,COMPNENT,SSN,DFN,VAQD
+14 SET ERR1="Invalid or missing access code"
+15 SET ERR2="Missing QRD Segment"
+16 SET ERR3="Could not resolve DFN"
+17 ;I $G(HLDUZ)'>0 S HLERR=ERR1 G ACK ;Invalid or missing access code
+18 SET HLQ=HL("Q")
SET HLFS=HL("FS")
SET HLECH=HL("ECH")
+19 ;
+20 ;hlech
SET COMPNENT=$EXTRACT(HL("ECH"))
+21 KILL VADC,HLERR
+22 ;D INITIZE^VAFHUTL9(HLDA) ;QUERY MESSAGE RETURNED IN VADC() ARRAY
+23 DO INIT1
+24 SET VAQD=$$SEG1^VAFHUTL9("QRD",1,"QRD")
+25 ;Missing QRD segment
IF VAQD=""
SET HLERR=ERR2
GOTO ACK
+26 ;
PARSE ;
+1 SET SSN=$PIECE(VAQD,HLFS,9)
+2 SET DFN=$$SSNDFN^VAFHUTL9(SSN)
+3 IF DFN'>0
SET HLERR=ERR3
GOTO ACK
+4 ;
+5 SET HLA("HLS",1)="MSA"_HL("FS")_$SELECT(HL:$SELECT(HL("VER")=2.1:"AR",1:"CR"),1:"CA")_HL("FS")_HL("MID")_HL("FS")_$PIECE(HL,"^",2)
+6 SET HLA("HLS",2)=VAQD
+7 ;
+8 SET HLA("HLS",3)=$$EN^VAFHLPID(DFN,",2,3,4,5,6,7,8,9,10B,11,12,13,14,15,16,17,18,19,22B")
+9 ;
ACK IF $DATA(HLERR)
SET HLA("HLS",2)="MSA"_HLFS_"AE"_HLFS_HLMID_HLFS_HLERR
GOTO EXIT
+1 ;
EXIT SET HLDT=$$NOW^XLFDT()
+1 DO GENERATE^HLMA("VAFH A19","LM",1,.HLRESLT,"",.HL)
+2 QUIT
+3 ;
INIT1 FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
SET X(I)=HLNODE
MERGE X(I)=HLNODE
+1 MERGE VADC=X
+2 QUIT
