VAFHQRY.m

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

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