Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMCM

IVMCM.m

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