EASPREC4 ;ALB/PJH,TDM - PROCESS INCOMING HL7 (QRY) MESSAGES ; 3/30/09 8:37pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,94**;15-MAR-01;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; CLONED FROM IVMPREC (ESR EVENT DRIVER)
;
; This routine will process (QRY) HL7 messages received from HEC
; At present, the (QRY) message queries for updated information
; for a single patient.
;
;
QRY ; - Receive Query Message requesting further information
;
S (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0
;
K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
S IVMRTN="IVMPREC"
K ^TMP($J,IVMRTN),^TMP("HLS",$J),^TMP("HLA",$J)
F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
.S CNT=0
.S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
.F S CNT=$O(HLNODE(CNT)) Q:'CNT D
..S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
;
; INITIALIZE HL7 VARIABLES
S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-Z07 SERVER"
S HLEID=$O(^ORD(101,"B",HLEID,0))
D INIT^HLFNC2(HLEID,.HL)
S HLEIDS="EAS ESR "_$P($$SITE^VASITE,"^",3)_" ORF-Z07 CLIENT"
S HLEIDS=$O(^ORD(101,"B",HLEIDS,0))
I '$D(^ORD(101,HLEID,775,"B",+HLEIDS)) S HLEIDS=""
;
; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
K ^TMP($J,"CC")
;
F IVMDA=0:0 S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="QRD"!($E(IVMSEG,1,3)="MSH") D
.I $E(IVMSEG,1,3)="MSH" S IVMMSHID=$P(IVMSEG,HLFS,10),MSGID=$P(IVMSEG,HLFS,10),HLMID=MSGID Q
.K HLERR S IVMFLAG=1
.S IVMSEG=$P(IVMSEG,HLFS,2,999) ; strip off segment name
.S IVMQLR=$P(IVMSEG,HLFS,7),DFN=$P(IVMSEG,HLFS,8),IVMIY=$P(IVMSEG,HLFS,10)
.D ERRCK
.I $D(HLERR) D ACK
.I '$D(HLERR) D
..N EVENTS
..; - if master query - create entry in (#301.9) file
..I IVMQLR>1,'DFN D Q
...S IVMSEG1="QRD"_HLFS_IVMSEG
...S:'$D(^IVM(301.9,1,10,0)) ^(0)="^301.9001DA^"
...S DA(1)=1,DIC="^IVM(301.9,1,10,",DIC(0)=""
...S X=IVMIY
...K DO,DD D FILE^DICN
...S DA=+Y,DA(1)=1,DIE="^IVM(301.9,1,10,"
...S DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1" D ^DIE
..;
..; Send AE if veteran has a Pseudo SSN and eligibility is not verified
..;Removed with IVM*2*105
..; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
..;
..; - if Primary Eligibility = Employee generate error & quit
..N DGPRIM
..S DGPRIM=$$GET1^DIQ(2,DFN_",",.361)
..I $G(DGPRIM)]"" S DGPRIM=$O(^DIC(8,"B",DGPRIM,0))
..I $G(DGPRIM)]"" S DGPRIM=$P($G(^DIC(8,DGPRIM,0)),U,9)
..I $G(DGPRIM)=14 S HLERR="Message not sent. Patient is an employee" D ACK Q
..;
..; Do Z07 Consistency checks and if fail generate error & quit
..I '$$EN^IVMZ07C(DFN) S HLERR="Message not sent. Inconsistencies in Record" D ACK K ^TMP($J,"CC") Q
..;
..; - prepare (ACK) message
..D:'$D(HLERR) MSGHDR ;header (MSH)
..D ACK ;message (MSA)
..;
..; - set up local HL7 event type code in MSH
..S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)="QRD"_HLFS_IVMSEG ; copy of incoming QRD
..;
..; - build 'FULL' transmission (note: without MSH segment)
..S IVMMTDT=$E(IVMIY,1,3)+1_"1231.9999"
..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
;
F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
I 'IVMFLAG S HLERR="Invalid Message Format" D ACK
S HLMTN="ORF"
S HLMTIENA=HLMTIEN
K ^TMP("HLA",$J) M ^TMP("HLA",$J)=^TMP("HLS",$J) K ^TMP("HLS",$J)
D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
;
QRYQ K DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID
K ^TMP("HLA",$J),^TMP("HLS",$J),^TMP($J,IVMRTN)
Q
;
;
ERRCK ; Perform error checks on HL7 (QRD) segment
I ('DFN!(DFN'=+DFN)) S:IVMQLR'>1 HLERR="Invalid DFN"
I '$D(HLERR) S IVMIY=$$FMDATE^HLFNC(IVMIY) I $E(IVMIY,4,7)'="0000"!($E(IVMIY,1,3)<292) S HLERR="Invalid Income Year"
I '$D(HLERR),$P(IVMSEG,HLFS,2)'="R" S HLERR="Invalid Query Format Code"
I '$D(HLERR),$P(IVMSEG,HLFS,3)'="I",($P(IVMSEG,HLFS,3)'="D") S HLERR="Invalid Query Priority"
I '$D(HLERR),$P(IVMSEG,HLFS,9)'="DEM" S HLERR="Invalid Query Subject Filter"
I '$D(HLERR),$P(IVMSEG,HLFS,12)'="T" S HLERR="Invalid Query Results Level"
;
Q
;
MSGHDR ; prepare header MSH segment in batch of 100 message events
; input variables:
; IVMCT record counter
; HLEVN event number
; MSHID outgoing message id
; HL array for protocol
;
N MID,HLRES
S HLEVN=$G(HLEVN)+1
D:(HLEVN#100)=1
.K MSHID,HLDT,HLDT1,HLMTIEN
.D INIT^HLFNC2(HLEID,.HL)
.D CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)
S MID=MSHID_"-"_HLEVN
D MSH^HLFNC2(.HL,MID,.HLRES)
S IVMCT=$G(IVMCT)+1
S ^TMP("HLS",$J,IVMCT)=HLRES
Q
;
ACK ; prepare positive and negative acknowledgement (ACK) message
; (positive acknowledgement: MSA segment with no MSH segment)
; (negative acknowledgement: MSA segment with MSH segment)
N MID,HLRES
S IVMCT=$G(IVMCT)+1
D:$D(HLERR)
.S IVMERROR=1
.S HLEVN=HLEVN+1
.D:(HLEVN#100)=1
..K HLMID,HLMTIEN,HLDT,HLDT1 ; set up batch
..D INIT^HLFNC2(HLEID,.HL)
..D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
.S MID=HLMID_"-"_HLEVN
.D MSH^HLFNC2(.HL,MID,.HLRES)
.S ^TMP("HLS",$J,IVMCT)=HLRES
.S IVMCT=IVMCT+1
.S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$S($G(DFN):$P($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")
I '$D(HLERR) S ^TMP("HLS",$J,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASPREC4 5510 printed Nov 22, 2024@17:05:45 Page 2
EASPREC4 ;ALB/PJH,TDM - PROCESS INCOMING HL7 (QRY) MESSAGES ; 3/30/09 8:37pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71,94**;15-MAR-01;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; CLONED FROM IVMPREC (ESR EVENT DRIVER)
+5 ;
+6 ; This routine will process (QRY) HL7 messages received from HEC
+7 ; At present, the (QRY) message queries for updated information
+8 ; for a single patient.
+9 ;
+10 ;
QRY ; - Receive Query Message requesting further information
+1 ;
+2 SET (HLEVN,IVMCT,IVMERROR,IVMFLAG)=0
+3 ;
+4 ;Variables needed to open/close last visit date and outpt visit QUERIES
KILL IVMQUERY("LTD"),IVMQUERY("OVIS")
+5 SET IVMRTN="IVMPREC"
+6 KILL ^TMP($JOB,IVMRTN),^TMP("HLS",$JOB),^TMP("HLA",$JOB)
+7 FOR SEGCNT=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+8 SET CNT=0
+9 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE
+10 FOR
SET CNT=$ORDER(HLNODE(CNT))
if 'CNT
QUIT
Begin DoDot:2
+11 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
End DoDot:2
End DoDot:1
+12 ;
+13 ; INITIALIZE HL7 VARIABLES
+14 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORF-Z07 SERVER"
+15 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
+16 DO INIT^HLFNC2(HLEID,.HL)
+17 SET HLEIDS="EAS ESR "_$PIECE($$SITE^VASITE,"^",3)_" ORF-Z07 CLIENT"
+18 SET HLEIDS=$ORDER(^ORD(101,"B",HLEIDS,0))
+19 IF '$DATA(^ORD(101,HLEID,775,"B",+HLEIDS))
SET HLEIDS=""
+20 ;
+21 ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
+22 KILL ^TMP($JOB,"CC")
+23 ;
+24 FOR IVMDA=0:0
SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
if 'IVMDA
QUIT
SET IVMSEG=$GET(^(IVMDA,0))
IF $EXTRACT(IVMSEG,1,3)="QRD"!($EXTRACT(IVMSEG,1,3)="MSH")
Begin DoDot:1
+25 IF $EXTRACT(IVMSEG,1,3)="MSH"
SET IVMMSHID=$PIECE(IVMSEG,HLFS,10)
SET MSGID=$PIECE(IVMSEG,HLFS,10)
SET HLMID=MSGID
QUIT
+26 KILL HLERR
SET IVMFLAG=1
+27 ; strip off segment name
SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)
+28 SET IVMQLR=$PIECE(IVMSEG,HLFS,7)
SET DFN=$PIECE(IVMSEG,HLFS,8)
SET IVMIY=$PIECE(IVMSEG,HLFS,10)
+29 DO ERRCK
+30 IF $DATA(HLERR)
DO ACK
+31 IF '$DATA(HLERR)
Begin DoDot:2
+32 NEW EVENTS
+33 ; - if master query - create entry in (#301.9) file
+34 IF IVMQLR>1
IF 'DFN
Begin DoDot:3
+35 SET IVMSEG1="QRD"_HLFS_IVMSEG
+36 if '$DATA(^IVM(301.9,1,10,0))
SET ^(0)="^301.9001DA^"
+37 SET DA(1)=1
SET DIC="^IVM(301.9,1,10,"
SET DIC(0)=""
+38 SET X=IVMIY
+39 KILL DO,DD
DO FILE^DICN
+40 SET DA=+Y
SET DA(1)=1
SET DIE="^IVM(301.9,1,10,"
+41 SET DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1"
DO ^DIE
End DoDot:3
QUIT
+42 ;
+43 ; Send AE if veteran has a Pseudo SSN and eligibility is not verified
+44 ;Removed with IVM*2*105
+45 ; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
+46 ;
+47 ; - if Primary Eligibility = Employee generate error & quit
+48 NEW DGPRIM
+49 SET DGPRIM=$$GET1^DIQ(2,DFN_",",.361)
+50 IF $GET(DGPRIM)]""
SET DGPRIM=$ORDER(^DIC(8,"B",DGPRIM,0))
+51 IF $GET(DGPRIM)]""
SET DGPRIM=$PIECE($GET(^DIC(8,DGPRIM,0)),U,9)
+52 IF $GET(DGPRIM)=14
SET HLERR="Message not sent. Patient is an employee"
DO ACK
QUIT
+53 ;
+54 ; Do Z07 Consistency checks and if fail generate error & quit
+55 IF '$$EN^IVMZ07C(DFN)
SET HLERR="Message not sent. Inconsistencies in Record"
DO ACK
KILL ^TMP($JOB,"CC")
QUIT
+56 ;
+57 ; - prepare (ACK) message
+58 ;header (MSH)
if '$DATA(HLERR)
DO MSGHDR
+59 ;message (MSA)
DO ACK
+60 ;
+61 ; - set up local HL7 event type code in MSH
+62 ; copy of incoming QRD
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)="QRD"_HLFS_IVMSEG
+63 ;
+64 ; - build 'FULL' transmission (note: without MSH segment)
+65 SET IVMMTDT=$EXTRACT(IVMIY,1,3)+1_"1231.9999"
+66 DO FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
End DoDot:2
End DoDot:1
+67 ;
+68 FOR Z="LTD","OVIS"
IF $GET(IVMQUERY(Z))
DO CLOSE^SDQ(IVMQUERY(Z))
KILL IVMQUERY(Z)
+69 IF 'IVMFLAG
SET HLERR="Invalid Message Format"
DO ACK
+70 SET HLMTN="ORF"
+71 SET HLMTIENA=HLMTIEN
+72 KILL ^TMP("HLA",$JOB)
MERGE ^TMP("HLA",$JOB)=^TMP("HLS",$JOB)
KILL ^TMP("HLS",$JOB)
+73 DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
+74 ;
QRYQ KILL DFN,DR,HLEVN,IVMCT,IVMDA,IVMERROR,IVMFLAG,IVMIY,IVMMTDT,IVMSEG,IVMSEG1,IVMQLR,IVMMSHID,MSGID,MSHID
+1 KILL ^TMP("HLA",$JOB),^TMP("HLS",$JOB),^TMP($JOB,IVMRTN)
+2 QUIT
+3 ;
+4 ;
ERRCK ; Perform error checks on HL7 (QRD) segment
+1 IF ('DFN!(DFN'=+DFN))
if IVMQLR'>1
SET HLERR="Invalid DFN"
+2 IF '$DATA(HLERR)
SET IVMIY=$$FMDATE^HLFNC(IVMIY)
IF $EXTRACT(IVMIY,4,7)'="0000"!($EXTRACT(IVMIY,1,3)<292)
SET HLERR="Invalid Income Year"
+3 IF '$DATA(HLERR)
IF $PIECE(IVMSEG,HLFS,2)'="R"
SET HLERR="Invalid Query Format Code"
+4 IF '$DATA(HLERR)
IF $PIECE(IVMSEG,HLFS,3)'="I"
IF ($PIECE(IVMSEG,HLFS,3)'="D")
SET HLERR="Invalid Query Priority"
+5 IF '$DATA(HLERR)
IF $PIECE(IVMSEG,HLFS,9)'="DEM"
SET HLERR="Invalid Query Subject Filter"
+6 IF '$DATA(HLERR)
IF $PIECE(IVMSEG,HLFS,12)'="T"
SET HLERR="Invalid Query Results Level"
+7 ;
+8 QUIT
+9 ;
MSGHDR ; prepare header MSH segment in batch of 100 message events
+1 ; input variables:
+2 ; IVMCT record counter
+3 ; HLEVN event number
+4 ; MSHID outgoing message id
+5 ; HL array for protocol
+6 ;
+7 NEW MID,HLRES
+8 SET HLEVN=$GET(HLEVN)+1
+9 if (HLEVN#100)=1
Begin DoDot:1
+10 KILL MSHID,HLDT,HLDT1,HLMTIEN
+11 DO INIT^HLFNC2(HLEID,.HL)
+12 DO CREATE^HLTF(.MSHID,.HLMTIEN,.HLDT,.HLDT1)
End DoDot:1
+13 SET MID=MSHID_"-"_HLEVN
+14 DO MSH^HLFNC2(.HL,MID,.HLRES)
+15 SET IVMCT=$GET(IVMCT)+1
+16 SET ^TMP("HLS",$JOB,IVMCT)=HLRES
+17 QUIT
+18 ;
ACK ; prepare positive and negative acknowledgement (ACK) message
+1 ; (positive acknowledgement: MSA segment with no MSH segment)
+2 ; (negative acknowledgement: MSA segment with MSH segment)
+3 NEW MID,HLRES
+4 SET IVMCT=$GET(IVMCT)+1
+5 if $DATA(HLERR)
Begin DoDot:1
+6 SET IVMERROR=1
+7 SET HLEVN=HLEVN+1
+8 if (HLEVN#100)=1
Begin DoDot:2
+9 ; set up batch
KILL HLMID,HLMTIEN,HLDT,HLDT1
+10 DO INIT^HLFNC2(HLEID,.HL)
+11 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
End DoDot:2
+12 SET MID=HLMID_"-"_HLEVN
+13 DO MSH^HLFNC2(.HL,MID,.HLRES)
+14 SET ^TMP("HLS",$JOB,IVMCT)=HLRES
+15 SET IVMCT=IVMCT+1
+16 SET ^TMP("HLS",$JOB,IVMCT)="MSA"_HLFS_"AE"_HLFS_MSGID_HLFS_HLERR_"- SSN "_$SELECT($GET(DFN):$PIECE($$PT^IVMUFNC4(DFN),"^",2),1:"NOT FOUND")
End DoDot:1
+17 IF '$DATA(HLERR)
SET ^TMP("HLS",$JOB,IVMCT)="MSA"_HLFS_"AA"_HLFS_HLMID
+18 ;
+19 QUIT
+20 ;
