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

IVMPTRN.m

Go to the documentation of this file.
  1. IVMPTRN ;ALB/MLI,SEK,RTK,BRM,BAJ,LBD,KUM - IVM BACKGROUND JOB/TRANSMISSIONS TO IVM CENTER; 10/28/2005 ; 7/13/10 4:11pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,12,17,28,34,74,79,89,105,143,147,196**;JUL 8,1996;Build 37
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; Supported ICRs
  1. ; #2701 - $$GETICN^MPIF001
  1. ; #7208 - $$EN^DGREGEEWS
  1. ;
  1. ; This routine is run nightly to send HL7 messages to the IVM Center for
  1. ; processing.
  1. ;
  1. BGJ ; - IVM Nightly Background Job
  1. ;
  1. ;for tests being held for the future, make them primary if now effective
  1. D FUTUREMT,FUTURERX
  1. ;
  1. ; - retransmit enrollment/eligibility queries with no reply
  1. D BATCH^DGENQRY1
  1. ;
  1. ; - retransmit income test (financial) queries with no reply
  1. D MONITOR^IVMCQ2
  1. ;
  1. ; - current year and previous year
  1. S IVMCURYR=$$LYR^DGMTSCU1(DT),IVMPREYR=$$LYR^DGMTSCU1(IVMCURYR)
  1. ;
  1. ;
  1. ; - Master Query Processing
  1. ;
  1. ; - respond to Master Query for previous year, if necessary
  1. S IVMREC=$$QRY(IVMPREYR) I IVMREC D RESP(IVMPREYR,+IVMREC),END
  1. ;
  1. ; - respond to Master Query for current year, if necessary
  1. S IVMREC=$$QRY(IVMCURYR) I IVMREC D RESP(IVMCURYR,+IVMREC),END
  1. ;
  1. ; - send regular 'nightly' transmissions
  1. D REG,END
  1. ;
  1. ; - perform retransmission processing
  1. D ENTRY^IVMPTRN4,END
  1. ;
  1. ; - process billing activity
  1. D EN^IVMPTRN5
  1. ;
  1. ; - auto-upload address changes from #301.5 if >14 days old
  1. ; - auto-delete non address changes from #301.5 if >30 days old
  1. N ADDRDT S ADDRDT(0)=30,ADDRDT(1)=14 D EN^IVMLDEMC(.ADDRDT)
  1. ;
  1. END ; - cleanup
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. K DA,DFN,DIE,DIK,DR,IVMCT,IVMDA,IVMDT,IVMGTOT,IVMINCYR,IVMINS,IVMMTDT
  1. K IVMNODE,IVMPAT,IVMPID,IVMQDT,IVMREC,IVMSTAT,X,%,VAFPID,IVMPREYR,IVMIY
  1. D CLEAN^IVMUFNC
  1. K ^TMP($J,"CC")
  1. Q
  1. ;
  1. REG ; Creates FULL query transmission for patient's
  1. ; that exist in file (#301.5) "ATR" x-ref
  1. ;
  1. ;
  1. ; - initialize variables for HL7/IVM
  1. S HLMTN="ORU"
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" "_HLMTN_"-Z07 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. K ^TMP($J,"CC") ;refresh Consistency Check counter
  1. D INIT^IVMUFNC(HLEID,.HL)
  1. ;
  1. ; - roll thru ATR x-ref for patients that require transmission
  1. K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
  1. S IVMIY=0
  1. F S IVMIY=$O(^IVM(301.5,"ATR",0,IVMIY)) Q:'IVMIY D
  1. .S IVMDA=0
  1. .F S IVMDA=$O(^IVM(301.5,"ATR",0,IVMIY,IVMDA)) Q:'IVMDA D
  1. ..;
  1. ..N EVENTS
  1. ..; - get node, income year, dfn
  1. ..S IVMNODE=$G(^IVM(301.5,+IVMDA,0)),IVMDT=+$P(IVMNODE,"^",2),DFN=+IVMNODE
  1. ..I 'DFN!'IVMDT Q
  1. ..;
  1. ..Q:($$STATUS^IVMPLOG(IVMDA,.EVENTS)=1)
  1. ..;
  1. ..; - if merged patient record, then update Transmission Status to
  1. ..; remove from "ATR" x-ref and do not create Z07 (IVM*2*147)
  1. ..I $D(^DPT(DFN,-9)) S X=$$CLEAR^IVMPLOG(IVMDA) K X Q
  1. ..;
  1. ..; IVM*2.0*196 - Do not send Z07
  1. ..; If DO YOU WISH TO ENROLL field in PATIENT (#2) file is YES AND
  1. ..; there is no current Enrollment record
  1. ..I $$GET1^DIQ(2,DFN_",",27.04,"I"),$$FINDCUR^DGENA(DFN)="" Q
  1. ..;
  1. ..S IVMMTDT=$$GETMTDT(DFN,IVMDT) ;IVM*2*143
  1. ..;
  1. ..; - prepare FULL transmission
  1. ..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,,,.IVMQUERY)
  1. ;
  1. ; After all transmissions send Bulletin of inconsistency check totals
  1. D EN^IVMPBUL
  1. ;
  1. F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
  1. ; - transmit remaining records
  1. D
  1. .N IVMEVENT
  1. .; event code for Full Data Transmission
  1. .S IVMEVENT="Z07"
  1. .D FILE^IVMPTRN3
  1. Q
  1. ;
  1. RESP(IVMINCYR,IVMREC) ; Response to the Master Query.
  1. ;
  1. ; Input: IVMINCYR - The income year for which the query was sent
  1. ; IVMREC - Internal entry number of query to be updated
  1. ;
  1. N DFN,IVMDA,IVMMTDT,DA,DR,DIE,EVENTS
  1. ;
  1. ; - initialize variables for HL7/IVM
  1. S HLMTN="ORF"
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" "_HLMTN_"-Z07 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. D INIT^IVMUFNC(HLEID,.HL)
  1. ;
  1. ; - roll thru AYR x-ref
  1. F DFN=0:0 S DFN=$O(^IVM(301.5,"AYR",IVMINCYR,DFN)) Q:'DFN D
  1. .F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,"AYR",IVMINCYR,DFN,IVMDA)) Q:'IVMDA D
  1. ..;
  1. ..; - check for STOP FLAG in file #301.5.
  1. ..I '$$CLOSED^IVMPLOG(IVMDA) D
  1. ...;
  1. ...; if means test was deleted, -10000 could be entered as income year
  1. ...; in ^IVM(301.5. close case if deleted.
  1. ...S IVMMTDT=$P($$LST^DGMTU(DFN,($E(IVMINCYR,1,3)+1)_"1231.9999"),"^",2)
  1. ...I IVMMTDT="" D CLOSE^IVMPTRN1(IVMINCYR,DFN,1,3) Q
  1. ...;
  1. ...;get EVENTS() array
  1. ...I $$STATUS^IVMPLOG(+IVMDA,.EVENTS)
  1. ...;
  1. ...; - prepare FULL transmission
  1. ...; note: 6th parameter is IVMFLL (=1 to include MSA segment)
  1. ...D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,1,,$G(IVMREC),.IVMQUERY)
  1. ;
  1. ; - transmit remaining records
  1. D
  1. .N IVMEVENT
  1. .; event code for Full Data Transmission
  1. .S IVMEVENT="Z07"
  1. .D FILE1^IVMPTRN3 ; added for v1.6 because of MSA segment (note: the original call was to FILE^IVMPTRN3)
  1. ;
  1. ;
  1. ; - update multiple in file #301.9. Stuff (.03) field with date/time
  1. ; of FULL query transmission.
  1. S DIE="^IVM(301.9,1,10,",DA=+IVMREC,DA(1)=1,DR=".03////"_$$NOW^XLFDT D ^DIE
  1. Q
  1. ;
  1. QRY(YEAR) ; See if Master Query has been satisfied for YEAR.
  1. ; Input: YEAR - The income year being checked
  1. ;
  1. ; Output: 1^2, where 1 = 0, if query does not need a response
  1. ; >0, if query needs a response (value
  1. ; equal to ien of sub-file entry
  1. ; in #301.9
  1. ; 2 = 0, if the request has not been received
  1. ; 1, if the request has been received
  1. N IVM,X,Y,Z
  1. I '$G(YEAR) S X="0^0" G QRYQ
  1. S Y=$O(^IVM(301.9,1,10,"AB",YEAR,"")) I 'Y S X="0^0" G QRYQ
  1. S IVM=$O(^IVM(301.9,1,10,"AB",YEAR,Y,0)) I 'IVM S X="0^0" G QRYQ
  1. S Z=$P($G(^IVM(301.9,1,10,+IVM,0)),"^",3)
  1. S X=$S(Z:0,1:IVM)_"^1"
  1. QRYQ Q X
  1. ;
  1. FUTUREMT ;
  1. ;Find future tests, and if now effective then make them primary. Will
  1. ;call the MT event driver unless NOT required, in which case the status
  1. ;will have the status will be changed to NO LONGER REQUIRED
  1. ;and may auto-create a Rx copay test
  1. ;
  1. N FDATE,IVMPAT,MTIEN,NODE,DFN,DATA
  1. ;
  1. S FDATE=0
  1. F S FDATE=$O(^IVM(301.5,"AC",FDATE)) Q:('FDATE) Q:(FDATE>DT) D
  1. .S IVMPAT=0
  1. .F S IVMPAT=$O(^IVM(301.5,"AC",FDATE,IVMPAT)) Q:'IVMPAT D
  1. ..S MTIEN=$O(^IVM(301.5,"AC",FDATE,IVMPAT,""),-1)
  1. ..I '$$FUTURECK("AC",FDATE,IVMPAT,MTIEN) K ^IVM(301.5,"AC",FDATE,IVMPAT,MTIEN)
  1. ..K DATA S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
  1. ..S DFN=+$G(^IVM(301.5,IVMPAT,0))
  1. ..I DFN S NODE=$$LST^DGMTU(DFN,DT_.9999,1) I $E($P(NODE,"^",2),1,3)=$E(DT,1,3),$P(NODE,"^",4)'="","R"'=$P(NODE,"^",4) K ^IVM(301.5,"AC",FDATE,IVMPAT,MTIEN) Q
  1. ..D MTPRIME^DGMTU4(MTIEN)
  1. Q
  1. ;
  1. FUTURERX ;
  1. ;Find future COPAY tests, and if now effective then make it primary.
  1. ;Will change the status to NO LONGER APPLICABLE if the vet is not
  1. ;subject to pharmacy copayments
  1. ;
  1. N FDATE,IVMPAT,MTIEN,NODE,DFN,DATA
  1. ;
  1. S FDATE=0
  1. F S FDATE=$O(^IVM(301.5,"AD",FDATE)) Q:('FDATE) Q:(FDATE>DT) D
  1. .S IVMPAT=0
  1. .F S IVMPAT=$O(^IVM(301.5,"AD",FDATE,IVMPAT)) Q:'IVMPAT D
  1. ..S MTIEN=$O(^IVM(301.5,"AD",FDATE,IVMPAT,""),-1)
  1. ..I '$$FUTURECK("AD",FDATE,IVMPAT,MTIEN) K ^IVM(301.5,"AD",FDATE,IVMPAT,MTIEN)
  1. ..K DATA S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
  1. ..S DFN=+$G(^IVM(301.5,IVMPAT,0))
  1. ..I DFN S NODE=$$LST^DGMTU(DFN,DT_.9999,2) I $E($P(NODE,"^",2),1,3)=$E(DT,1,3),$P(NODE,"^",4)'="" K ^IVM(301.5,"AD",FDATE,IVMPAT,MTIEN) Q
  1. ..D RXPRIME^DGMTU4(MTIEN)
  1. Q
  1. ;
  1. FUTURECK(TYPE,FDATE,IVMPAT,MTIEN) ;
  1. ; Check the Future MT or CP xref for a valid income test entry,
  1. ; and Delete all invalid xref entries.
  1. N VALID,MTREC S VALID=1,MTREC=0
  1. ;
  1. ; Remove duplicate entries from cross reference, leaving last entry
  1. F S MTREC=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)) Q:(MTREC=MTIEN!('MTREC)) K ^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)
  1. ;
  1. I '$D(^IVM(301.5,IVMPAT,0)) S VALID=0 Q VALID
  1. I '$D(^DGMT(408.31,MTIEN,0)) S VALID=0 Q VALID
  1. I FDATE'=+(^DGMT(408.31,MTIEN,0)) S VALID=0 Q VALID
  1. ;
  1. Q VALID
  1. ;
  1. GETMTDT(DFN,IVMDT) ;Get date of primary Means Test or RX Copay Test (IVM*2*143)
  1. N IDT,MT,MTDT,MTSTA,RX,RXDT,RXSTA
  1. I '$G(DFN)!('$G(IVMDT)) Q ""
  1. S IDT=($E(IVMDT,1,3)+1)_"1231.9999"
  1. ;Get most recent primary MT
  1. S MT=$$LST^DGMTU(DFN,IDT,1),MTDT=$P(MT,"^",2),MTSTA=$P(MT,"^",4)
  1. ;Get most recent primary RX Copay Test
  1. S RX=$$LST^DGMTU(DFN,IDT,2),RXDT=$P(RX,"^",2),RXSTA=$P(RX,"^",4)
  1. ;If there's no RX Copay Test, then return the Means Test date.
  1. I 'RXDT Q MTDT
  1. ;If the RX Copay Test date is greater than or equal to the Means
  1. ;Test date, and the RX Copay Test status is Exempt, Non-Exempt,
  1. ;or Pending Adjudication, then return the RX Copay Test date.
  1. I RXDT'<MTDT,("^E^M^P^"[("^"_RXSTA_"^")) Q RXDT
  1. ;Otherwise, return the Means Test date.
  1. Q MTDT