- IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG,HM,KUM - PROCESS INCOME TEST (Z10) TRANSMISSIONS ;3/30/20 1:48pm
- ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123,115,183,190,162**;21-OCT-94;Build 44
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;Supported ICRs
- ; #3812 - $$FINDCUR^DGENA()
- ; #2056 - $$GET1^DIQ(}
- ; #2462 - Reference to file #27.11
- ;
- ORF ; Handler for ORF type HL7 messages received from HEC
- ;
- ; Make sure POSTMASTER DUZ instead of DUZ of Person who
- ; started Incoming Logical Link.
- S DUZ=.5
- N CNT,IVMRTN,SEGCNT
- S IVMRTN="IVMCMX" ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED
- K ^TMP($J,IVMRTN),DIC
- S (DGMSGF,DGMTMSG)=1 ; HL7 rtn. Don't need DG interative messages.
- S HLECH=HL("ECH"),HLQ=HL("Q"),HLMID=HL("MID")
- K %,%H,%I D NOW^%DTC S HLDT=%
- 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)
- S HLDA=HLMTIEN
- ;
- N SEG,EVENT,MSGID
- S:'$D(HLEVN) HLEVN=0
- D NXTSEG^DGENUPL(HLDA,0,.SEG)
- Q:(SEG("TYPE")'="MSH") ;would not have reached here if this happened!
- S EVENT=$P(SEG(9),$E(HLECH),2)
- ;
- ; INITIALIZE HL7 VARIABLES
- S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER"
- S HLEID=$O(^ORD(101,"B",HLEID,0))
- D INIT^HLFNC2(HLEID,.HL)
- S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
- ;
- ; Handle means test signature ORF (Z06) event
- I EVENT="Z06" D ORF^IVMPREC7
- ;
- ; Handle income test ORF (Z10) event
- I EVENT="Z10" D Z10
- ;
- ; Handle enrollment/elig. ORF (Z11) event
- I EVENT="Z11" D
- .S MSGID=SEG(10)
- .D ORFZ11^DGENUPL(HLDA,MSGID)
- ;
- K ^TMP($J,IVMRTN)
- Q
- ;
- ;
- Z10 ; Entry point for receipt of ORF~Z10 transmission
- ; The Income Test (Z10) transmission has the following format:
- ;
- ; BHS ORF msgs do not include batch header or trailer.
- ; {MSH
- ; PID They will include the sequence: MSA
- ; ZIC QRD
- ; ZIR QRF
- ; {ZDP These segments will follow the MSH segment.
- ; ZIC
- ; ZIR
- ; }
- ; {NTE Updated for IVM*2.0*190
- ; }
- ; {ZMT
- ; }
- ; ZBT
- ; }
- ; BTS
- ;
- S IVMORF=1 ; set ORF msg flag
- S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0 ; init vars
- ;
- ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2)
- S IVMTYPE=5,IVMZ10F=1
- ;
- ; - loop through the msg in (#772 file), and process (PROC) msgs
- S IVMDA=0 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D PROC Q:'IVMDA
- ;
- ; - if ORF msg flag, update the Query Tran Log
- I $G(IVMORF) D
- .I $G(DFN),$D(IVMMCI) D
- ..N IVMCR
- ..S IVMCR=$P("1^2^3^7^5^6^4","^",IVMTYPE) ;map reason to test type
- ..D FIND^IVMCQ2(DFN,IVMMCI,HLDT,$S($D(HLERR):5,1:IVMCR),1)
- ;
- ; - if tests are uploaded, generate notification msg
- I $D(^TMP($J,"IVMBULL")) D ^IVMCMB
- ;
- ENQ ;
- K IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI
- K ^TMP($J,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN
- K DGMTMSG,IVMZ10F
- Q
- ;
- PROC ; Process each HL7 message from (#772) file
- ;
- N IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA,SRCTST,IVMREGO ;IVM*2.0*190
- S DGMTACT="ADD"
- D PRIOR^DGMTEVT
- S IVMZ10="UPLOAD IN PROGRESS"
- S IVMFUTR=0 ;this flag will indicate whether or not a test with a future date is being uploaded
- S IVMMTIEN=0
- ;
- S MSGID=$P(IVMSEG,HLFS,10) ; msg control id for ACK's
- ; - check if DCD messaging is enabled
- I '$$DCDON^IVMUPAR1() D PROB^IVMCMC("Facility has DCD messaging disabled") Q
- ;
- ; - check HL7 msg structure for errors
- K HLERR,^TMP($J,"IVMCM")
- D ^IVMCMC I $D(HLERR) K:HLERR="" HLERR Q
- ;
- ; Determine type of test/transmission
- S IVMTYPE=0
- ;
- ; - was a means test sent?
- I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S IVMTYPE=1 ; MT trans
- ;
- ; - if MT and CT transmitted, error - pt can't have both unless
- ; one is a deletion, but HEC not currently handling that situation
- I IVMTYPE,$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) D PROB^IVMCMC("Patient can not have both a Means Test and Copay Test") Q
- I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S IVMTYPE=2 ; CT trans
- ;
- ; IVM*2.0*162 - BEGIN
- S IVMREGO=""
- I (IVMTYPE=1)!(IVMTYPE=2) D
- .;Find patient's current enrollment record
- .N IVMENIEN,IVMENRC
- .S IVMENIEN=""
- .S IVMENRC=""
- .; $$FINDCUR^DGENA(DFN) is supported by ICR #3812
- .S IVMENIEN=$$FINDCUR^DGENA(DFN)
- .I IVMENIEN S IVMENRC=$$GET1^DIQ(27.11,IVMENIEN_",",.04,"I")
- .I $G(IVMENRC)=25 S IVMREGO="Y"
- I IVMREGO="Y" D PROB^IVMCMC("Enrollment Status is Registration Only - not subject to Means Test or RX Copay Test") Q
- ; IVM*2.0*162 - END
- ; - if no MT or CT or LTC then Income Screening
- I 'IVMTYPE,'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) S IVMTYPE=3 ; IS trans
- ;
- ;send an eligibility query if no eligibility code
- I '$$ELIG^IVMCUF1(DFN),'$$PENDING^DGENQRY(DFN) I $$SEND^DGENQRY1(DFN)
- ;
- ; obtain locks used to sychronize upload with local income test options
- D GETLOCKS^IVMCUPL(DFN)
- ;
- ;
- MT ; If transmission is a Means Test
- N NODE0,RET,CODE,DATA,MTSIG,MTSIGDT,CATCA ;IVM*2.0*183 HM
- S HLQ=$G(HL("Q"))
- S:HLQ="" HLQ=""""""
- I IVMTYPE=1 D I $D(HLERR) G PROCQ
- .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2))
- .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,25))
- .S HSDATE=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,24))
- .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22)
- .S SRCTST=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,18) ;IVM*2.0*190
- .S MTSIG=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,27)
- .S MTSIGDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,15))
- .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1)
- .; Check that test is for same year
- .I $P(IVMLAST,U,2),$E($P(IVMLAST,U,2),1,3)'=$E(IVMMTDT,1,3) S IVMLAST=""
- .Q:$$UPDMTSIG^IVMCMF(+IVMLAST,TMSTAMP,MTSIG,MTSIGDT)
- .I $$Z06MT^EASPTRN1(+IVMLAST) D PROB^IVMCMC("IVM Means Test already on file for this year") Q
- .I '$$ELIG^IVMUFNC5(DFN) D PROB^IVMCMC("Means Test upload not appropriate for current patient") Q
- .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D I $D(HLERR) Q ;IVM*2.0*183 HM
- ..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1"))
- ..S CATC=$$CATC^IVMUFNC5(CATCZMT)
- ..I '+$G(CATC) D PROB^IVMCMC("Only Means Tests in current/previous income years are valid (not effective)") K CATC Q ;IVM*2.0*183 HM
- ..;IVM*2.0*183 HM Check if MT Copay Exempt or GMT Copay Required
- ..S CATCA=$$ACCMT^IVMUFNC5(CATCZMT) ;IVM*2.0*183 HM
- ..I '+$G(CATCA) D PROB^IVMCMC("Only Means Tests greater than or equal to one year prior to the VFA Start Date of 1/1/2013 are valid for MT COPAY EXEMPT or GMT COPAY REQUIRED") K CATCA Q ;IVM*2.0*183 HM
- .;
- .; - perform edit checks and file MT
- .D CHKDT
- .;deletion indicator sent?
- .I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,3)=HLQ D Q
- ..D
- ...;if there is a future test for that income year, delete that
- ...N IEN,DATA,IVMPAT
- ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1,.IVMPAT)
- ...I IEN S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
- ...I IEN,$D(^DGMT(408.31,IEN,0)) D
- ....S IVMMTIEN=IEN
- ....S IVMFUTR=1
- ...E D
- ....S IVMFUTR=0
- ..Q:('IVMMTIEN)
- ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
- ..I $$EN^IVMCMD(IVMMTIEN) D
- ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
- ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
- ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
- .;
- .;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded
- .I TMSTAMP D
- ..S NODE=""
- ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1)
- ..Q:'IVMMTIEN
- ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
- .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
- .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5),(HSDATE=$P(NODE,"^")) Q
- .;
- .D DELTYPE^IVMCMD(DFN,IVMMTDT,2)
- .D EN^IVMCM1
- ;
- ;
- CT ; If transmission is a Copay Test
- N NODE0,RET,CODE,DATA
- I IVMTYPE=2 D I $D(HLERR) G PROCQ
- .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2))
- .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,25))
- .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,22)
- .S SRCTST=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,18) ;IVM*2.0*190
- .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,2)
- .S IVMCPAY=$$RXST^IBARXEU(DFN)
- .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)") Q
- .; - perform edit checks and file CT
- .D CHKDT
- .;deletion indicator sent?
- .I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,3)=HLQ D Q
- ..D
- ...;if there is a future test for that income year, delete that
- ...N IEN,DATA,IVMPAT
- ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2,.IVMPAT)
- ...I IEN S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
- ...I IEN,$D(^DGMT(408.31,IEN,0)) D
- ....S IVMMTIEN=IEN
- ....S IVMFUTR=1
- ...E D
- ....S IVMFUTR=0
- ..Q:('IVMMTIEN)
- ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
- ..I $$EN^IVMCMD(IVMMTIEN) D
- ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
- ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
- ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
- .;
- .;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded
- .I TMSTAMP D
- ..S NODE=""
- ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2)
- ..Q:'IVMMTIEN
- ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
- .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
- .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5) Q
- .;
- .D DELTYPE^IVMCMD(DFN,IVMMTDT,1)
- .D EN^IVMCM1
- ;
- IS ; - If transmission is income screening info only then do not process
- ; - outside of the scope of MTS
- ;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ
- I IVMTYPE=3 S IVMMTDT=0
- ;
- LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST)
- I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) D LTC^IVMCM1
- ;
- PROCQ ;
- ; release locks used to sychronize upload with local income test options
- D RELLOCKS^IVMCUPL(DFN)
- Q
- ;
- CHKDT ; check date of income test being uploaded
- ; Is it a future date? If so, set IVMFUTR=1
- ;
- ; IVMMTIEN is the IEN of current primary test for the year
- ;
- I $E($P(IVMLAST,"^",2),1,3)=$E(IVMMTDT,1,3) S IVMMTIEN=+IVMLAST
- I IVMMTDT>DT S IVMFUTR=1
- Q
- FUTURE(DFN,YEAR,TYPE,IVMPAT) ;
- ;Returns the ien of the future test, if there is one
- ;Inputs: DFN
- ; YEAR - income year
- ; TYPE - type of test
- ;Output:
- ; function value - ien of future means test, if there is one, "" otherwise
- ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference)
- ;
- N RET
- S RET=""
- S IVMPAT=$$FIND^IVMPLOG(DFN,YEAR)
- I IVMPAT S RET=$P($G(^IVM(301.5,IVMPAT,0)),"^",$S(TYPE=1:6,1:7))
- Q RET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCM 11211 printed Dec 13, 2024@02:01:13 Page 2
- IVMCM ;ALB/SEK,KCL,RTK,AEG,BRM,AEG,HM,KUM - PROCESS INCOME TEST (Z10) TRANSMISSIONS ;3/30/20 1:48pm
- +1 ;;2.0;INCOME VERIFICATION MATCH;**12,17,28,41,44,53,34,49,59,55,63,77,74,123,115,183,190,162**;21-OCT-94;Build 44
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;Supported ICRs
- +5 ; #3812 - $$FINDCUR^DGENA()
- +6 ; #2056 - $$GET1^DIQ(}
- +7 ; #2462 - Reference to file #27.11
- +8 ;
- ORF ; Handler for ORF type HL7 messages received from HEC
- +1 ;
- +2 ; Make sure POSTMASTER DUZ instead of DUZ of Person who
- +3 ; started Incoming Logical Link.
- +4 SET DUZ=.5
- +5 NEW CNT,IVMRTN,SEGCNT
- +6 ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED
- SET IVMRTN="IVMCMX"
- +7 KILL ^TMP($JOB,IVMRTN),DIC
- +8 ; HL7 rtn. Don't need DG interative messages.
- SET (DGMSGF,DGMTMSG)=1
- +9 SET HLECH=HL("ECH")
- SET HLQ=HL("Q")
- SET HLMID=HL("MID")
- +10 KILL %,%H,%I
- DO NOW^%DTC
- SET HLDT=%
- +11 FOR SEGCNT=1:1
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- Begin DoDot:1
- +12 SET CNT=0
- +13 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE
- +14 FOR
- SET CNT=$ORDER(HLNODE(CNT))
- if 'CNT
- QUIT
- Begin DoDot:2
- +15 SET ^TMP($JOB,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
- End DoDot:2
- End DoDot:1
- +16 SET HLDA=HLMTIEN
- +17 ;
- +18 NEW SEG,EVENT,MSGID
- +19 if '$DATA(HLEVN)
- SET HLEVN=0
- +20 DO NXTSEG^DGENUPL(HLDA,0,.SEG)
- +21 ;would not have reached here if this happened!
- if (SEG("TYPE")'="MSH")
- QUIT
- +22 SET EVENT=$PIECE(SEG(9),$EXTRACT(HLECH),2)
- +23 ;
- +24 ; INITIALIZE HL7 VARIABLES
- +25 SET HLEID="VAMC "_$PIECE($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER"
- +26 SET HLEID=$ORDER(^ORD(101,"B",HLEID,0))
- +27 DO INIT^HLFNC2(HLEID,.HL)
- +28 SET HLEIDS=$ORDER(^ORD(101,HLEID,775,"B",0))
- +29 ;
- +30 ; Handle means test signature ORF (Z06) event
- +31 IF EVENT="Z06"
- DO ORF^IVMPREC7
- +32 ;
- +33 ; Handle income test ORF (Z10) event
- +34 IF EVENT="Z10"
- DO Z10
- +35 ;
- +36 ; Handle enrollment/elig. ORF (Z11) event
- +37 IF EVENT="Z11"
- Begin DoDot:1
- +38 SET MSGID=SEG(10)
- +39 DO ORFZ11^DGENUPL(HLDA,MSGID)
- End DoDot:1
- +40 ;
- +41 KILL ^TMP($JOB,IVMRTN)
- +42 QUIT
- +43 ;
- +44 ;
- Z10 ; Entry point for receipt of ORF~Z10 transmission
- +1 ; The Income Test (Z10) transmission has the following format:
- +2 ;
- +3 ; BHS ORF msgs do not include batch header or trailer.
- +4 ; {MSH
- +5 ; PID They will include the sequence: MSA
- +6 ; ZIC QRD
- +7 ; ZIR QRF
- +8 ; {ZDP These segments will follow the MSH segment.
- +9 ; ZIC
- +10 ; ZIR
- +11 ; }
- +12 ; {NTE Updated for IVM*2.0*190
- +13 ; }
- +14 ; {ZMT
- +15 ; }
- +16 ; ZBT
- +17 ; }
- +18 ; BTS
- +19 ;
- +20 ; set ORF msg flag
- SET IVMORF=1
- +21 ; init vars
- SET (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0
- +22 ;
- ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2)
- +1 SET IVMTYPE=5
- SET IVMZ10F=1
- +2 ;
- +3 ; - loop through the msg in (#772 file), and process (PROC) msgs
- +4 SET IVMDA=0
- FOR
- SET IVMDA=$ORDER(^TMP($JOB,IVMRTN,IVMDA))
- if 'IVMDA
- QUIT
- SET IVMSEG=$GET(^(IVMDA,0))
- IF $EXTRACT(IVMSEG,1,3)="MSH"
- DO PROC
- if 'IVMDA
- QUIT
- +5 ;
- +6 ; - if ORF msg flag, update the Query Tran Log
- +7 IF $GET(IVMORF)
- Begin DoDot:1
- +8 IF $GET(DFN)
- IF $DATA(IVMMCI)
- Begin DoDot:2
- +9 NEW IVMCR
- +10 ;map reason to test type
- SET IVMCR=$PIECE("1^2^3^7^5^6^4","^",IVMTYPE)
- +11 DO FIND^IVMCQ2(DFN,IVMMCI,HLDT,$SELECT($DATA(HLERR):5,1:IVMCR),1)
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 ; - if tests are uploaded, generate notification msg
- +14 IF $DATA(^TMP($JOB,"IVMBULL"))
- DO ^IVMCMB
- +15 ;
- ENQ ;
- +1 KILL IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI
- +2 KILL ^TMP($JOB,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN
- +3 KILL DGMTMSG,IVMZ10F
- +4 QUIT
- +5 ;
- PROC ; Process each HL7 message from (#772) file
- +1 ;
- +2 ;IVM*2.0*190
- NEW IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA,SRCTST,IVMREGO
- +3 SET DGMTACT="ADD"
- +4 DO PRIOR^DGMTEVT
- +5 SET IVMZ10="UPLOAD IN PROGRESS"
- +6 ;this flag will indicate whether or not a test with a future date is being uploaded
- SET IVMFUTR=0
- +7 SET IVMMTIEN=0
- +8 ;
- +9 ; msg control id for ACK's
- SET MSGID=$PIECE(IVMSEG,HLFS,10)
- +10 ; - check if DCD messaging is enabled
- +11 IF '$$DCDON^IVMUPAR1()
- DO PROB^IVMCMC("Facility has DCD messaging disabled")
- QUIT
- +12 ;
- +13 ; - check HL7 msg structure for errors
- +14 KILL HLERR,^TMP($JOB,"IVMCM")
- +15 DO ^IVMCMC
- IF $DATA(HLERR)
- if HLERR=""
- KILL HLERR
- QUIT
- +16 ;
- +17 ; Determine type of test/transmission
- +18 SET IVMTYPE=0
- +19 ;
- +20 ; - was a means test sent?
- +21 ; MT trans
- IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,2)
- SET IVMTYPE=1
- +22 ;
- +23 ; - if MT and CT transmitted, error - pt can't have both unless
- +24 ; one is a deletion, but HEC not currently handling that situation
- +25 IF IVMTYPE
- IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2)
- DO PROB^IVMCMC("Patient can not have both a Means Test and Copay Test")
- QUIT
- +26 ; CT trans
- IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2)
- SET IVMTYPE=2
- +27 ;
- +28 ; IVM*2.0*162 - BEGIN
- +29 SET IVMREGO=""
- +30 IF (IVMTYPE=1)!(IVMTYPE=2)
- Begin DoDot:1
- +31 ;Find patient's current enrollment record
- +32 NEW IVMENIEN,IVMENRC
- +33 SET IVMENIEN=""
- +34 SET IVMENRC=""
- +35 ; $$FINDCUR^DGENA(DFN) is supported by ICR #3812
- +36 SET IVMENIEN=$$FINDCUR^DGENA(DFN)
- +37 IF IVMENIEN
- SET IVMENRC=$$GET1^DIQ(27.11,IVMENIEN_",",.04,"I")
- +38 IF $GET(IVMENRC)=25
- SET IVMREGO="Y"
- End DoDot:1
- +39 IF IVMREGO="Y"
- DO PROB^IVMCMC("Enrollment Status is Registration Only - not subject to Means Test or RX Copay Test")
- QUIT
- +40 ; IVM*2.0*162 - END
- +41 ; - if no MT or CT or LTC then Income Screening
- +42 ; IS trans
- IF 'IVMTYPE
- IF '$PIECE($GET(^TMP($JOB,"IVMCM","ZMT4")),HLFS,2)
- SET IVMTYPE=3
- +43 ;
- +44 ;send an eligibility query if no eligibility code
- +45 IF '$$ELIG^IVMCUF1(DFN)
- IF '$$PENDING^DGENQRY(DFN)
- IF $$SEND^DGENQRY1(DFN)
- +46 ;
- +47 ; obtain locks used to sychronize upload with local income test options
- +48 DO GETLOCKS^IVMCUPL(DFN)
- +49 ;
- +50 ;
- MT ; If transmission is a Means Test
- +1 ;IVM*2.0*183 HM
- NEW NODE0,RET,CODE,DATA,MTSIG,MTSIGDT,CATCA
- +2 SET HLQ=$GET(HL("Q"))
- +3 if HLQ=""
- SET HLQ=""""""
- +4 IF IVMTYPE=1
- Begin DoDot:1
- +5 SET IVMMTDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,2))
- +6 SET TMSTAMP=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,25))
- +7 SET HSDATE=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,24))
- +8 SET SOURCE=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,22)
- +9 ;IVM*2.0*190
- SET SRCTST=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,18)
- +10 SET MTSIG=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,27)
- +11 SET MTSIGDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,15))
- +12 SET IVMLAST=$$LST^DGMTU(DFN,$EXTRACT(IVMMTDT,1,3)_1231,1)
- +13 ; Check that test is for same year
- +14 IF $PIECE(IVMLAST,U,2)
- IF $EXTRACT($PIECE(IVMLAST,U,2),1,3)'=$EXTRACT(IVMMTDT,1,3)
- SET IVMLAST=""
- +15 if $$UPDMTSIG^IVMCMF(+IVMLAST,TMSTAMP,MTSIG,MTSIGDT)
- QUIT
- +16 IF $$Z06MT^EASPTRN1(+IVMLAST)
- DO PROB^IVMCMC("IVM Means Test already on file for this year")
- QUIT
- +17 IF '$$ELIG^IVMUFNC5(DFN)
- DO PROB^IVMCMC("Means Test upload not appropriate for current patient")
- QUIT
- +18 ;IVM*2.0*183 HM
- IF $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT)
- Begin DoDot:2
- +19 NEW CATCZMT
- SET CATCZMT=$GET(^TMP($JOB,"IVMCM","ZMT1"))
- +20 SET CATC=$$CATC^IVMUFNC5(CATCZMT)
- +21 ;IVM*2.0*183 HM
- IF '+$GET(CATC)
- DO PROB^IVMCMC("Only Means Tests in current/previous income years are valid (not effective)")
- KILL CATC
- QUIT
- +22 ;IVM*2.0*183 HM Check if MT Copay Exempt or GMT Copay Required
- +23 ;IVM*2.0*183 HM
- SET CATCA=$$ACCMT^IVMUFNC5(CATCZMT)
- +24 ;IVM*2.0*183 HM
- IF '+$GET(CATCA)
- DO PROB^IVMCMC("Only Means Tests greater than or equal to one year prior to the VFA Start Date of 1/1/2013 are valid for MT COPAY EXEMPT or GMT COPAY REQUIRED")
- KILL CATCA
- QUIT
- End DoDot:2
- IF $DATA(HLERR)
- QUIT
- +25 ;
- +26 ; - perform edit checks and file MT
- +27 DO CHKDT
- +28 ;deletion indicator sent?
- +29 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT1")),HLFS,3)=HLQ
- Begin DoDot:2
- +30 Begin DoDot:3
- +31 ;if there is a future test for that income year, delete that
- +32 NEW IEN,DATA,IVMPAT
- +33 SET IEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),1,.IVMPAT)
- +34 IF IEN
- SET DATA(.06)=""
- IF $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
- +35 IF IEN
- IF $DATA(^DGMT(408.31,IEN,0))
- Begin DoDot:4
- +36 SET IVMMTIEN=IEN
- +37 SET IVMFUTR=1
- End DoDot:4
- +38 IF '$TEST
- Begin DoDot:4
- +39 SET IVMFUTR=0
- End DoDot:4
- End DoDot:3
- +40 if ('IVMMTIEN)
- QUIT
- +41 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
- +42 IF $$EN^IVMCMD(IVMMTIEN)
- Begin DoDot:3
- +43 SET RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
- +44 SET CODE=$SELECT(($EXTRACT($PIECE(RET,"^",2),1,3)=$EXTRACT(DT,1,3)):$PIECE(RET,"^",4),1:"")
- +45 DO ADD^IVMCMB(DFN,IVMTYPE,$SELECT(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$GET(NODE0),$$GETCODE^DGMTH($PIECE(NODE0,"^",3)),CODE)
- End DoDot:3
- End DoDot:2
- QUIT
- +46 ;
- +47 ;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded
- +48 IF TMSTAMP
- Begin DoDot:2
- +49 SET NODE=""
- +50 IF IVMFUTR
- NEW IVMMTIEN
- SET IVMMTIEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),1)
- +51 if 'IVMMTIEN
- QUIT
- +52 SET NODE=$GET(^DGMT(408.31,IVMMTIEN,2))
- End DoDot:2
- +53 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
- +54 IF TMSTAMP
- IF TMSTAMP=$PIECE(NODE,"^",2)
- IF IVMMTDT=$PIECE(NODE0,"^")
- IF SOURCE=$PIECE(NODE,"^",5)
- IF (HSDATE=$PIECE(NODE,"^"))
- QUIT
- +55 ;
- +56 DO DELTYPE^IVMCMD(DFN,IVMMTDT,2)
- +57 DO EN^IVMCM1
- End DoDot:1
- IF $DATA(HLERR)
- GOTO PROCQ
- +58 ;
- +59 ;
- CT ; If transmission is a Copay Test
- +1 NEW NODE0,RET,CODE,DATA
- +2 IF IVMTYPE=2
- Begin DoDot:1
- +3 SET IVMMTDT=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,2))
- +4 SET TMSTAMP=$$FMDATE^HLFNC($PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,25))
- +5 SET SOURCE=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,22)
- +6 ;IVM*2.0*190
- SET SRCTST=$PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,18)
- +7 SET IVMLAST=$$LST^DGMTU(DFN,$EXTRACT(IVMMTDT,1,3)_1231,2)
- +8 SET IVMCPAY=$$RXST^IBARXEU(DFN)
- +9 IF $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT)
- DO PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)")
- QUIT
- +10 ; - perform edit checks and file CT
- +11 DO CHKDT
- +12 ;deletion indicator sent?
- +13 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT2")),HLFS,3)=HLQ
- Begin DoDot:2
- +14 Begin DoDot:3
- +15 ;if there is a future test for that income year, delete that
- +16 NEW IEN,DATA,IVMPAT
- +17 SET IEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),2,.IVMPAT)
- +18 IF IEN
- SET DATA(.07)=""
- IF $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
- +19 IF IEN
- IF $DATA(^DGMT(408.31,IEN,0))
- Begin DoDot:4
- +20 SET IVMMTIEN=IEN
- +21 SET IVMFUTR=1
- End DoDot:4
- +22 IF '$TEST
- Begin DoDot:4
- +23 SET IVMFUTR=0
- End DoDot:4
- End DoDot:3
- +24 if ('IVMMTIEN)
- QUIT
- +25 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
- +26 IF $$EN^IVMCMD(IVMMTIEN)
- Begin DoDot:3
- +27 SET RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
- +28 SET CODE=$SELECT(($EXTRACT($PIECE(RET,"^",2),1,3)=$EXTRACT(DT,1,3)):$PIECE(RET,"^",4),1:"")
- +29 DO ADD^IVMCMB(DFN,IVMTYPE,$SELECT(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$GET(NODE0),$$GETCODE^DGMTH($PIECE(NODE0,"^",3)),CODE)
- End DoDot:3
- End DoDot:2
- QUIT
- +30 ;
- +31 ;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded
- +32 IF TMSTAMP
- Begin DoDot:2
- +33 SET NODE=""
- +34 IF IVMFUTR
- NEW IVMMTIEN
- SET IVMMTIEN=$$FUTURE(DFN,($EXTRACT(IVMMTDT,1,3)-1),2)
- +35 if 'IVMMTIEN
- QUIT
- +36 SET NODE=$GET(^DGMT(408.31,IVMMTIEN,2))
- End DoDot:2
- +37 SET NODE0=$GET(^DGMT(408.31,IVMMTIEN,0))
- +38 IF TMSTAMP
- IF TMSTAMP=$PIECE(NODE,"^",2)
- IF IVMMTDT=$PIECE(NODE0,"^")
- IF SOURCE=$PIECE(NODE,"^",5)
- QUIT
- +39 ;
- +40 DO DELTYPE^IVMCMD(DFN,IVMMTDT,1)
- +41 DO EN^IVMCM1
- End DoDot:1
- IF $DATA(HLERR)
- GOTO PROCQ
- +42 ;
- IS ; - If transmission is income screening info only then do not process
- +1 ; - outside of the scope of MTS
- +2 ;I IVMTYPE=3 S IVMMTDT=0 D EN^IVMCM1 I $D(HLERR) G PROCQ
- +3 IF IVMTYPE=3
- SET IVMMTDT=0
- +4 ;
- LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST)
- +1 IF $PIECE($GET(^TMP($JOB,"IVMCM","ZMT4")),HLFS,2)
- DO LTC^IVMCM1
- +2 ;
- PROCQ ;
- +1 ; release locks used to sychronize upload with local income test options
- +2 DO RELLOCKS^IVMCUPL(DFN)
- +3 QUIT
- +4 ;
- CHKDT ; check date of income test being uploaded
- +1 ; Is it a future date? If so, set IVMFUTR=1
- +2 ;
- +3 ; IVMMTIEN is the IEN of current primary test for the year
- +4 ;
- +5 IF $EXTRACT($PIECE(IVMLAST,"^",2),1,3)=$EXTRACT(IVMMTDT,1,3)
- SET IVMMTIEN=+IVMLAST
- +6 IF IVMMTDT>DT
- SET IVMFUTR=1
- +7 QUIT
- FUTURE(DFN,YEAR,TYPE,IVMPAT) ;
- +1 ;Returns the ien of the future test, if there is one
- +2 ;Inputs: DFN
- +3 ; YEAR - income year
- +4 ; TYPE - type of test
- +5 ;Output:
- +6 ; function value - ien of future means test, if there is one, "" otherwise
- +7 ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference)
- +8 ;
- +9 NEW RET
- +10 SET RET=""
- +11 SET IVMPAT=$$FIND^IVMPLOG(DFN,YEAR)
- +12 IF IVMPAT
- SET RET=$PIECE($GET(^IVM(301.5,IVMPAT,0)),"^",$SELECT(TYPE=1:6,1:7))
- +13 QUIT RET