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