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

IVM2071A.m

Go to the documentation of this file.
  1. IVM2071A ;ALB/RMM - Means Test Cleanup Utility ; 23 DEC 2002
  1. ;;2.0;INCOME VERIFICATION MATCH;**71**;21-OCT-94
  1. ;
  1. ; This Distribution/Cleanup will check every record in the Patient
  1. ; File #2, for a corresponding entry in the Annual Means Test File
  1. ; #408.31.
  1. ;
  1. ; An IVM Financial Query (QRY) Message will be sent when the veteran's
  1. ; Income Test meets the following criteria:
  1. ; There must be a current Primary Test (no earlier than income
  1. ; year 2001)
  1. ; The test must have been entered early (before the CAD)
  1. ; There must have been a similar test in the previous income year
  1. ; (both Means Tests or both Copay Test) or last year had a Copay
  1. ; and this year has a Means Test.
  1. ; The test's status must not have been an improvement over the
  1. ; prior income year's test
  1. ;---------------------------------------------------------------------
  1. ; Temporary Storage/Tracking Global Details:
  1. ; ^XTMP("IVM71",1) - Number of records processed
  1. ; ^XTMP("IVM71",2) - Number of queries transmitted
  1. ;---------------------------------------------------------------------
  1. ;
  1. EN ; Begin Processing...
  1. ; Write message to installation device and to INSTALL file (#9.7)
  1. D BMES^XPDUTL("Future MT Distribution/Cleanup")
  1. D MES^XPDUTL("Once the distribution/cleanup has completed, a MailMan ")
  1. D MES^XPDUTL("message will be sent that will report the number of")
  1. D MES^XPDUTL("records, that were changed.")
  1. D BMES^XPDUTL("Beginning cleanup process "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. ;
  1. INIT ;
  1. ; Initialize tracking global (See text above for description)
  1. N X,X1,X2
  1. I '$D(^XTMP("IVM71",0)) D
  1. .S X1=DT,X2=30 D C^%DTC
  1. .S ^XTMP("IVM71",0)=X_"^"_$$DT^XLFDT_"^IVM*2*71 FUTURE MT CLEANUP UPLOAD ERRORS"
  1. .S (^XTMP("IVM71",1),^XTMP("IVM71",2))=0
  1. ;
  1. I $D(^XTMP("IVM71",0)) S (^XTMP("IVM71",1),^XTMP("IVM71",2))=0
  1. ;
  1. ;Task job using TaskMan
  1. N ZTDESC,ZTIO,ZTRTN,ZTSK,ZTDTH
  1. S ZTDTH=$$NOW^XLFDT
  1. S ZTIO="",ZTRTN="EN1^IVM2071A",ZTDESC="IVM*2*71 FUTURE MT CLEANUP UPLOAD ERRORS"
  1. D ^%ZTLOAD
  1. I '$D(ZTSK) D BMES^XPDUTL("Task failed!")
  1. E D BMES^XPDUTL("Task# "_ZTSK_" queued ")
  1. Q
  1. EN1 ; Process Control Body
  1. ;
  1. N DFN,CURMT,LSTMT,TTYPE,LTYPE,CURST,LSTST,CURDT,LSTDT,IMP,PRINYR
  1. S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. .;
  1. .; If there is no Primary in this income year (or 2001), Quit
  1. .S CURMT="",TTYPE=1,CURMT=$$LST^DGMTU(DFN,,TTYPE)
  1. .S:'CURMT TTYPE=2,CURMT=$$LST^DGMTU(DFN,,TTYPE)
  1. .I $E($P(CURMT,U,2),1,3)<301 Q
  1. .S ^XTMP("IVM71",1)=^XTMP("IVM71",1)+1
  1. .;
  1. .; If there is no test for the Prior Income Year, Quit
  1. .S PRINYR=($E($P(CURMT,U,2),1,3)-1)_1231
  1. .S LSTMT="",LTYPE=1,LSTMT=$$LST^DGMTU(DFN,PRINYR,LTYPE)
  1. .S:'LSTMT LTYPE=2,LSTMT=$$LST^DGMTU(DFN,PRINYR,LTYPE)
  1. .Q:'LSTMT
  1. .;
  1. .; If this years test wasn't entered early, Quit
  1. .I ($E($P(CURMT,U,2),4,7)+1)>($E($P(LSTMT,U,2),4,7)) Q
  1. .;
  1. .; If this year's test was a CP and last year's test was a MT, Quit
  1. .I TTYPE=2,LTYPE=1 Q
  1. .;
  1. .; If the Income Test's status was improved, Quit
  1. .S CURST=$P(CURMT,U,4),LSTST=$P(LSTMT,U,4),IMP=1
  1. .I TTYPE=LTYPE D
  1. ..I CURST=LSTST S IMP=0 Q
  1. ..I TTYPE=1,CURST="C",LSTST="A" S IMP=0 Q
  1. ..I TTYPE=1,CURST="G",LSTST="A" S IMP=0 Q
  1. ..I TTYPE=1,CURST="C",LSTST="G" S IMP=0 Q
  1. ..I TTYPE=2,CURST="M",LSTST="E" S IMP=0 Q
  1. .;
  1. .Q:IMP
  1. .;
  1. .; The test met the criteria, send Query to HEC and increment counter
  1. .I $$QUERY(DFN) S ^XTMP("IVM71",2)=^XTMP("IVM71",2)+1
  1. .;
  1. ;
  1. ; Send a mailman msg to the user with the results
  1. D MAIL^IVM2071M
  1. D MES^XPDUTL(" >>Distribution/Cleanup process completed: "_$$FMTE^XLFDT($$NOW^XLFDT))
  1. ;
  1. Q
  1. ;
  1. QUERY(DFN) ;
  1. N SUCCESS,DATA,IVMIEN,IVMPAT,IVMCID,DGENDA,USER,NOTIFY,OPTION,ERROR
  1. N HLMTN,HLDAP,HLEID,HL,HLERR,HLEVN,HLSDT,HLARYTYP,HLFORMAT,HLRESLT,HLFS
  1. ;
  1. ; Adding an entry in the IVM FINANCIAL QUERY LOG
  1. S SUCCESS=0,DATA(.01)=DFN,DATA(.02)=$$NOW^XLFDT
  1. S IVMIEN=$$ADD^DGENDBS(301.62,,.DATA)
  1. K DATA,^TMP("HLS",$J)
  1. ;
  1. ; Initialize the HL7 Variables
  1. S HLMTN="QRY",HLDAP="IVM"
  1. S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" QRY-Z10 SERVER"
  1. S HLEID=$O(^ORD(101,"B",HLEID,0))
  1. D INIT^HLFNC2(HLEID,.HL)
  1. I $G(HL)]"" S HLERR=$P(HL,"^",2)
  1. S HLEVN=0,HLSDT=$$NOW^XLFDT
  1. I $D(HLERR) S ERROR="HL7 INITIALIZATION ERROR - "_HLERR G QUERYQ
  1. ;
  1. ; Get the Patient Identifiers
  1. I '$$GETPAT^IVMUFNC(DFN,.IVMPAT) S ERROR="PATIENT NOT FOUND" G QUERYQ
  1. I (IVMPAT("DOB")="") S ERROR="PATIENT DATE OF BIRTH IS REQUIRED" G QUERYQ
  1. I (IVMPAT("SSN")="") S ERROR="PATIENT SSN IS REQUIRED" G QUERYQ
  1. I (IVMPAT("SEX")="") S ERROR="PATIENT SEX IS REQUIRED" G QUERYQ
  1. I "MF"'[IVMPAT("SEX") S ERROR="PATIENT SEX IS NOT VALID" G QUERYQ
  1. ;
  1. ; Build HL7 Financial Query (QRY) Message Components...
  1. D QRD,QRF
  1. ;
  1. ; Send the HL7 Financial Query (QRY) Message...
  1. S HLARYTYP="GM",HLFORMAT=1
  1. D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
  1. I $P($G(HLRESLT),"^",2)]"" S HLERR=$P(HLRESLT,"^",3)
  1. I $D(HLERR) S ERROR="HL7 TRANSMISSION ERROR - "_HLERR G QUERYQ
  1. S IVMCID=+HLRESLT
  1. ;
  1. ; Update the Record in the LOG file...
  1. S DGENDA=IVMIEN,DATA(.03)=0,DATA(.04)=$G(USER),DATA(.05)=IVMCID
  1. S DATA(.06)="",DATA(.07)=$G(OPTION),DATA(.08)=$S($G(NOTIFY):1,1:0)
  1. I '$$UPD^DGENDBS(301.62,.DGENDA,.DATA) S ERROR="UPDATE OF RECORD "_IVMIEN_" IN 301.62 FAILED!" G QUERYQ
  1. S SUCCESS=1
  1. QUERYQ ; exit and clean-up
  1. D KILL^HLTRANS
  1. K ^TMP("HLS",$J)
  1. Q SUCCESS
  1. ;
  1. QRD ; Build (HL7) QRD segment for patient
  1. N IVMQRD
  1. S $P(IVMQRD,HLFS,1)=$$HLDATE^HLFNC(HLSDT),$P(IVMQRD,HLFS,2)="R"
  1. S $P(IVMQRD,HLFS,3)="I",$P(IVMQRD,HLFS,4)=DFN,$P(IVMQRD,HLFS,7)="1~RD"
  1. S $P(IVMQRD,HLFS,8)=IVMPAT("SSN"),$P(IVMQRD,HLFS,9)="FIN"
  1. S $P(IVMQRD,HLFS,10)=$$HLDATE^HLFNC($$LYR^DGMTSCU1(DT)),$P(IVMQRD,HLFS,12)="T"
  1. S ^TMP("HLS",$J,1)="QRD"_HLFS_IVMQRD
  1. Q
  1. ;
  1. QRF ; Build HL7 (QRF) segment for patient
  1. N IVMQRF
  1. S $P(IVMQRF,HLFS,1)="IVM"
  1. S $P(IVMQRF,HLFS,4)=$$HLDATE^HLFNC(IVMPAT("DOB"))
  1. S $P(IVMQRF,HLFS,5)=IVMPAT("SEX")
  1. S ^TMP("HLS",$J,2)="QRF"_HLFS_IVMQRF
  1. Q