| [613] | 1 | IVM2071A ;ALB/RMM - Means Test Cleanup Utility ; 23 DEC 2002
|
|---|
| 2 | ;;2.0;INCOME VERIFICATION MATCH;**71**;21-OCT-94
|
|---|
| 3 | ;
|
|---|
| 4 | ; This Distribution/Cleanup will check every record in the Patient
|
|---|
| 5 | ; File #2, for a corresponding entry in the Annual Means Test File
|
|---|
| 6 | ; #408.31.
|
|---|
| 7 | ;
|
|---|
| 8 | ; An IVM Financial Query (QRY) Message will be sent when the veteran's
|
|---|
| 9 | ; Income Test meets the following criteria:
|
|---|
| 10 | ; There must be a current Primary Test (no earlier than income
|
|---|
| 11 | ; year 2001)
|
|---|
| 12 | ; The test must have been entered early (before the CAD)
|
|---|
| 13 | ; There must have been a similar test in the previous income year
|
|---|
| 14 | ; (both Means Tests or both Copay Test) or last year had a Copay
|
|---|
| 15 | ; and this year has a Means Test.
|
|---|
| 16 | ; The test's status must not have been an improvement over the
|
|---|
| 17 | ; prior income year's test
|
|---|
| 18 | ;---------------------------------------------------------------------
|
|---|
| 19 | ; Temporary Storage/Tracking Global Details:
|
|---|
| 20 | ; ^XTMP("IVM71",1) - Number of records processed
|
|---|
| 21 | ; ^XTMP("IVM71",2) - Number of queries transmitted
|
|---|
| 22 | ;---------------------------------------------------------------------
|
|---|
| 23 | ;
|
|---|
| 24 | EN ; Begin Processing...
|
|---|
| 25 | ; Write message to installation device and to INSTALL file (#9.7)
|
|---|
| 26 | D BMES^XPDUTL("Future MT Distribution/Cleanup")
|
|---|
| 27 | D MES^XPDUTL("Once the distribution/cleanup has completed, a MailMan ")
|
|---|
| 28 | D MES^XPDUTL("message will be sent that will report the number of")
|
|---|
| 29 | D MES^XPDUTL("records, that were changed.")
|
|---|
| 30 | D BMES^XPDUTL("Beginning cleanup process "_$$FMTE^XLFDT($$NOW^XLFDT))
|
|---|
| 31 | ;
|
|---|
| 32 | INIT ;
|
|---|
| 33 | ; Initialize tracking global (See text above for description)
|
|---|
| 34 | N X,X1,X2
|
|---|
| 35 | I '$D(^XTMP("IVM71",0)) D
|
|---|
| 36 | .S X1=DT,X2=30 D C^%DTC
|
|---|
| 37 | .S ^XTMP("IVM71",0)=X_"^"_$$DT^XLFDT_"^IVM*2*71 FUTURE MT CLEANUP UPLOAD ERRORS"
|
|---|
| 38 | .S (^XTMP("IVM71",1),^XTMP("IVM71",2))=0
|
|---|
| 39 | ;
|
|---|
| 40 | I $D(^XTMP("IVM71",0)) S (^XTMP("IVM71",1),^XTMP("IVM71",2))=0
|
|---|
| 41 | ;
|
|---|
| 42 | ;Task job using TaskMan
|
|---|
| 43 | N ZTDESC,ZTIO,ZTRTN,ZTSK,ZTDTH
|
|---|
| 44 | S ZTDTH=$$NOW^XLFDT
|
|---|
| 45 | S ZTIO="",ZTRTN="EN1^IVM2071A",ZTDESC="IVM*2*71 FUTURE MT CLEANUP UPLOAD ERRORS"
|
|---|
| 46 | D ^%ZTLOAD
|
|---|
| 47 | I '$D(ZTSK) D BMES^XPDUTL("Task failed!")
|
|---|
| 48 | E D BMES^XPDUTL("Task# "_ZTSK_" queued ")
|
|---|
| 49 | Q
|
|---|
| 50 | EN1 ; Process Control Body
|
|---|
| 51 | ;
|
|---|
| 52 | N DFN,CURMT,LSTMT,TTYPE,LTYPE,CURST,LSTST,CURDT,LSTDT,IMP,PRINYR
|
|---|
| 53 | S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN D
|
|---|
| 54 | .;
|
|---|
| 55 | .; If there is no Primary in this income year (or 2001), Quit
|
|---|
| 56 | .S CURMT="",TTYPE=1,CURMT=$$LST^DGMTU(DFN,,TTYPE)
|
|---|
| 57 | .S:'CURMT TTYPE=2,CURMT=$$LST^DGMTU(DFN,,TTYPE)
|
|---|
| 58 | .I $E($P(CURMT,U,2),1,3)<301 Q
|
|---|
| 59 | .S ^XTMP("IVM71",1)=^XTMP("IVM71",1)+1
|
|---|
| 60 | .;
|
|---|
| 61 | .; If there is no test for the Prior Income Year, Quit
|
|---|
| 62 | .S PRINYR=($E($P(CURMT,U,2),1,3)-1)_1231
|
|---|
| 63 | .S LSTMT="",LTYPE=1,LSTMT=$$LST^DGMTU(DFN,PRINYR,LTYPE)
|
|---|
| 64 | .S:'LSTMT LTYPE=2,LSTMT=$$LST^DGMTU(DFN,PRINYR,LTYPE)
|
|---|
| 65 | .Q:'LSTMT
|
|---|
| 66 | .;
|
|---|
| 67 | .; If this years test wasn't entered early, Quit
|
|---|
| 68 | .I ($E($P(CURMT,U,2),4,7)+1)>($E($P(LSTMT,U,2),4,7)) Q
|
|---|
| 69 | .;
|
|---|
| 70 | .; If this year's test was a CP and last year's test was a MT, Quit
|
|---|
| 71 | .I TTYPE=2,LTYPE=1 Q
|
|---|
| 72 | .;
|
|---|
| 73 | .; If the Income Test's status was improved, Quit
|
|---|
| 74 | .S CURST=$P(CURMT,U,4),LSTST=$P(LSTMT,U,4),IMP=1
|
|---|
| 75 | .I TTYPE=LTYPE D
|
|---|
| 76 | ..I CURST=LSTST S IMP=0 Q
|
|---|
| 77 | ..I TTYPE=1,CURST="C",LSTST="A" S IMP=0 Q
|
|---|
| 78 | ..I TTYPE=1,CURST="G",LSTST="A" S IMP=0 Q
|
|---|
| 79 | ..I TTYPE=1,CURST="C",LSTST="G" S IMP=0 Q
|
|---|
| 80 | ..I TTYPE=2,CURST="M",LSTST="E" S IMP=0 Q
|
|---|
| 81 | .;
|
|---|
| 82 | .Q:IMP
|
|---|
| 83 | .;
|
|---|
| 84 | .; The test met the criteria, send Query to HEC and increment counter
|
|---|
| 85 | .I $$QUERY(DFN) S ^XTMP("IVM71",2)=^XTMP("IVM71",2)+1
|
|---|
| 86 | .;
|
|---|
| 87 | ;
|
|---|
| 88 | ; Send a mailman msg to the user with the results
|
|---|
| 89 | D MAIL^IVM2071M
|
|---|
| 90 | D MES^XPDUTL(" >>Distribution/Cleanup process completed: "_$$FMTE^XLFDT($$NOW^XLFDT))
|
|---|
| 91 | ;
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | QUERY(DFN) ;
|
|---|
| 95 | N SUCCESS,DATA,IVMIEN,IVMPAT,IVMCID,DGENDA,USER,NOTIFY,OPTION,ERROR
|
|---|
| 96 | N HLMTN,HLDAP,HLEID,HL,HLERR,HLEVN,HLSDT,HLARYTYP,HLFORMAT,HLRESLT,HLFS
|
|---|
| 97 | ;
|
|---|
| 98 | ; Adding an entry in the IVM FINANCIAL QUERY LOG
|
|---|
| 99 | S SUCCESS=0,DATA(.01)=DFN,DATA(.02)=$$NOW^XLFDT
|
|---|
| 100 | S IVMIEN=$$ADD^DGENDBS(301.62,,.DATA)
|
|---|
| 101 | K DATA,^TMP("HLS",$J)
|
|---|
| 102 | ;
|
|---|
| 103 | ; Initialize the HL7 Variables
|
|---|
| 104 | S HLMTN="QRY",HLDAP="IVM"
|
|---|
| 105 | S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" QRY-Z10 SERVER"
|
|---|
| 106 | S HLEID=$O(^ORD(101,"B",HLEID,0))
|
|---|
| 107 | D INIT^HLFNC2(HLEID,.HL)
|
|---|
| 108 | I $G(HL)]"" S HLERR=$P(HL,"^",2)
|
|---|
| 109 | S HLEVN=0,HLSDT=$$NOW^XLFDT
|
|---|
| 110 | I $D(HLERR) S ERROR="HL7 INITIALIZATION ERROR - "_HLERR G QUERYQ
|
|---|
| 111 | ;
|
|---|
| 112 | ; Get the Patient Identifiers
|
|---|
| 113 | I '$$GETPAT^IVMUFNC(DFN,.IVMPAT) S ERROR="PATIENT NOT FOUND" G QUERYQ
|
|---|
| 114 | I (IVMPAT("DOB")="") S ERROR="PATIENT DATE OF BIRTH IS REQUIRED" G QUERYQ
|
|---|
| 115 | I (IVMPAT("SSN")="") S ERROR="PATIENT SSN IS REQUIRED" G QUERYQ
|
|---|
| 116 | I (IVMPAT("SEX")="") S ERROR="PATIENT SEX IS REQUIRED" G QUERYQ
|
|---|
| 117 | I "MF"'[IVMPAT("SEX") S ERROR="PATIENT SEX IS NOT VALID" G QUERYQ
|
|---|
| 118 | ;
|
|---|
| 119 | ; Build HL7 Financial Query (QRY) Message Components...
|
|---|
| 120 | D QRD,QRF
|
|---|
| 121 | ;
|
|---|
| 122 | ; Send the HL7 Financial Query (QRY) Message...
|
|---|
| 123 | S HLARYTYP="GM",HLFORMAT=1
|
|---|
| 124 | D GENERATE^HLMA(HLEID,HLARYTYP,HLFORMAT,.HLRESLT)
|
|---|
| 125 | I $P($G(HLRESLT),"^",2)]"" S HLERR=$P(HLRESLT,"^",3)
|
|---|
| 126 | I $D(HLERR) S ERROR="HL7 TRANSMISSION ERROR - "_HLERR G QUERYQ
|
|---|
| 127 | S IVMCID=+HLRESLT
|
|---|
| 128 | ;
|
|---|
| 129 | ; Update the Record in the LOG file...
|
|---|
| 130 | S DGENDA=IVMIEN,DATA(.03)=0,DATA(.04)=$G(USER),DATA(.05)=IVMCID
|
|---|
| 131 | S DATA(.06)="",DATA(.07)=$G(OPTION),DATA(.08)=$S($G(NOTIFY):1,1:0)
|
|---|
| 132 | I '$$UPD^DGENDBS(301.62,.DGENDA,.DATA) S ERROR="UPDATE OF RECORD "_IVMIEN_" IN 301.62 FAILED!" G QUERYQ
|
|---|
| 133 | S SUCCESS=1
|
|---|
| 134 | QUERYQ ; exit and clean-up
|
|---|
| 135 | D KILL^HLTRANS
|
|---|
| 136 | K ^TMP("HLS",$J)
|
|---|
| 137 | Q SUCCESS
|
|---|
| 138 | ;
|
|---|
| 139 | QRD ; Build (HL7) QRD segment for patient
|
|---|
| 140 | N IVMQRD
|
|---|
| 141 | S $P(IVMQRD,HLFS,1)=$$HLDATE^HLFNC(HLSDT),$P(IVMQRD,HLFS,2)="R"
|
|---|
| 142 | S $P(IVMQRD,HLFS,3)="I",$P(IVMQRD,HLFS,4)=DFN,$P(IVMQRD,HLFS,7)="1~RD"
|
|---|
| 143 | S $P(IVMQRD,HLFS,8)=IVMPAT("SSN"),$P(IVMQRD,HLFS,9)="FIN"
|
|---|
| 144 | S $P(IVMQRD,HLFS,10)=$$HLDATE^HLFNC($$LYR^DGMTSCU1(DT)),$P(IVMQRD,HLFS,12)="T"
|
|---|
| 145 | S ^TMP("HLS",$J,1)="QRD"_HLFS_IVMQRD
|
|---|
| 146 | Q
|
|---|
| 147 | ;
|
|---|
| 148 | QRF ; Build HL7 (QRF) segment for patient
|
|---|
| 149 | N IVMQRF
|
|---|
| 150 | S $P(IVMQRF,HLFS,1)="IVM"
|
|---|
| 151 | S $P(IVMQRF,HLFS,4)=$$HLDATE^HLFNC(IVMPAT("DOB"))
|
|---|
| 152 | S $P(IVMQRF,HLFS,5)=IVMPAT("SEX")
|
|---|
| 153 | S ^TMP("HLS",$J,2)="QRF"_HLFS_IVMQRF
|
|---|
| 154 | Q
|
|---|
