- IVMPREC ;ALB/MLI/ESD,BAJ - PROCESS INCOMING HL7 (QRY) MESSAGES ; 8/17/06 2:37pm
- ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,15,18,24,34,105**;JUL 8,1996;Build 2
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; 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=$O(^ORD(101,HLEID,775,"B",0))
- ;
- ; 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
- ..;
- ..; - 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)
- ;
- ; IVM*2.0*105 BAJ 11/02/2005
- ; send AE if inconsistencies found.
- I ^TMP($J,"CC",0) S HLERR="Message not sent. Inconsistencies in Record" D ACK
- K ^TMP($J,"CC")
- ;
- 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[HIVMPREC 5049 printed Jan 18, 2025@03:02:37 Page 2
- IVMPREC ;ALB/MLI/ESD,BAJ - PROCESS INCOMING HL7 (QRY) MESSAGES ; 8/17/06 2:37pm
- +1 ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,15,18,24,34,105**;JUL 8,1996;Build 2
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; This routine will process (QRY) HL7 messages received from HEC
- +5 ; At present, the (QRY) message queries for updated information
- +6 ; for a single patient.
- +7 ;
- +8 ;
- 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=$ORDER(^ORD(101,HLEID,775,"B",0))
- +18 ;
- +19 ; IVM*2.0*105 BAJ 11/02/2005 Temp global for Consistency Checks
- +20 KILL ^TMP($JOB,"CC")
- +21 ;
- +22 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
- +23 IF $EXTRACT(IVMSEG,1,3)="MSH"
- SET IVMMSHID=$PIECE(IVMSEG,HLFS,10)
- SET MSGID=$PIECE(IVMSEG,HLFS,10)
- SET HLMID=MSGID
- QUIT
- +24 KILL HLERR
- SET IVMFLAG=1
- +25 ; strip off segment name
- SET IVMSEG=$PIECE(IVMSEG,HLFS,2,999)
- +26 SET IVMQLR=$PIECE(IVMSEG,HLFS,7)
- SET DFN=$PIECE(IVMSEG,HLFS,8)
- SET IVMIY=$PIECE(IVMSEG,HLFS,10)
- +27 DO ERRCK
- +28 IF $DATA(HLERR)
- DO ACK
- +29 IF '$DATA(HLERR)
- Begin DoDot:2
- +30 NEW EVENTS
- +31 ; - if master query - create entry in (#301.9) file
- +32 IF IVMQLR>1
- IF 'DFN
- Begin DoDot:3
- +33 SET IVMSEG1="QRD"_HLFS_IVMSEG
- +34 if '$DATA(^IVM(301.9,1,10,0))
- SET ^(0)="^301.9001DA^"
- +35 SET DA(1)=1
- SET DIC="^IVM(301.9,1,10,"
- SET DIC(0)=""
- +36 SET X=IVMIY
- +37 KILL DO,DD
- DO FILE^DICN
- +38 SET DA=+Y
- SET DA(1)=1
- SET DIE="^IVM(301.9,1,10,"
- +39 SET DR=".02///NOW;.04////^S X=IVMMSHID;10////^S X=IVMSEG1"
- DO ^DIE
- End DoDot:3
- QUIT
- +40 ;
- +41 ; Send AE if veteran has a Pseudo SSN and eligibility is not verified
- +42 ; Removed with IVM*2*105
- +43 ; I '$$SNDPSSN^IVMPTRN7(DFN) S HLERR="Pseudo SSN must be verified" D ACK Q
- +44 ;
- +45 ; - prepare (ACK) message
- +46 ;header (MSH)
- if '$DATA(HLERR)
- DO MSGHDR
- +47 ;message (MSA)
- DO ACK
- +48 ;
- +49 ; - set up local HL7 event type code in MSH
- +50 ; copy of incoming QRD
- SET IVMCT=IVMCT+1
- SET ^TMP("HLS",$JOB,IVMCT)="QRD"_HLFS_IVMSEG
- +51 ;
- +52 ; - build 'FULL' transmission (note: without MSH segment)
- +53 SET IVMMTDT=$EXTRACT(IVMIY,1,3)+1_"1231.9999"
- +54 DO FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,1,,.IVMQUERY)
- End DoDot:2
- End DoDot:1
- +55 ;
- +56 ; IVM*2.0*105 BAJ 11/02/2005
- +57 ; send AE if inconsistencies found.
- +58 IF ^TMP($JOB,"CC",0)
- SET HLERR="Message not sent. Inconsistencies in Record"
- DO ACK
- +59 KILL ^TMP($JOB,"CC")
- +60 ;
- +61 FOR Z="LTD","OVIS"
- IF $GET(IVMQUERY(Z))
- DO CLOSE^SDQ(IVMQUERY(Z))
- KILL IVMQUERY(Z)
- +62 IF 'IVMFLAG
- SET HLERR="Invalid Message Format"
- DO ACK
- +63 SET HLMTN="ORF"
- +64 SET HLMTIENA=HLMTIEN
- +65 KILL ^TMP("HLA",$JOB)
- MERGE ^TMP("HLA",$JOB)=^TMP("HLS",$JOB)
- KILL ^TMP("HLS",$JOB)
- +66 DO GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,"GB",1,.HLRESLTA,HLMTIENA,.HLP)
- +67 ;
- 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 ;