- 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 Feb 18, 2025@23:26:08 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