[613] | 1 | IVMUPUR ;ALB/CPM - PURGE IVM TRANSMISSION RECORDS ; 22-MAY-94
|
---|
| 2 | ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | EN ; Queue job to purge IVM Transmissions from file #301.6
|
---|
| 6 | ;
|
---|
| 7 | I $$NODUZ() G ENQ
|
---|
| 8 | ;
|
---|
| 9 | S IVMPYR=1699+$E(DT,1,3)
|
---|
| 10 | ;
|
---|
| 11 | W !!,"This option is used to purge data from the IVM TRANSMISSIONS (#301.6) file."
|
---|
| 12 | W !,"Entries in this file will only be purged for corresponding case records"
|
---|
| 13 | W !,"in the IVM PATIENT (#301.5) file which have been closed."
|
---|
| 14 | ;
|
---|
| 15 | W !!,"You will purge transmission records for an entire income year's worth of cases."
|
---|
| 16 | W !,"However, you must select an income year prior to the year which corresponds"
|
---|
| 17 | W !,"to the current year's Means Tests. Since this year's Means Tests are based"
|
---|
| 18 | W !,"on ",IVMPYR," income, you must select an income year prior to ",IVMPYR,".",!!
|
---|
| 19 | ;
|
---|
| 20 | SEL ; - select an income year prior to that which current MT's are based
|
---|
| 21 | S %DT("A")="Select the Income Year for which to purge transmissions: "
|
---|
| 22 | S %DT(0)=2860000,%DT="AE" D ^%DT K %DT G:$D(DTOUT)!(Y<0) ENQ
|
---|
| 23 | I $E(Y,1,3)+1700'<IVMPYR W !!,"Invalid year entered. Enter a year prior to ",IVMPYR,".",! G SEL
|
---|
| 24 | S IVMYR=$E(Y,1,3)_"0000"
|
---|
| 25 | ;
|
---|
| 26 | ; - okay to task off the job?
|
---|
| 27 | I $$OKAY D TASK
|
---|
| 28 | ;
|
---|
| 29 | ENQ K IVMPYR,IVMYR
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | ;
|
---|
| 33 | NODUZ() ; Check for the existence of DUZ
|
---|
| 34 | ; Input: NONE
|
---|
| 35 | ; Output: 0 -- has DUZ, 1 -- no DUZ
|
---|
| 36 | N Y
|
---|
| 37 | I '$G(DUZ) S Y=1 W !!,"Your DUZ code must be defined in order to use this option.",!
|
---|
| 38 | Q +$G(Y)
|
---|
| 39 | ;
|
---|
| 40 | OKAY() ; Okay to queue this job?
|
---|
| 41 | ; Input: NONE
|
---|
| 42 | ; Output: 0 -- No, not okay, 1 -- Yes, okay to continue
|
---|
| 43 | N DIR,DIRUT,DUOUT,DTOUT,Y
|
---|
| 44 | S DIR(0)="Y",DIR("A")="Is it okay to queue this job"
|
---|
| 45 | S DIR("?",1)="Enter: 'Y' if you wish to task off this job, or"
|
---|
| 46 | S DIR("?")=" 'N' or '^' to quit this option." W ! D ^DIR
|
---|
| 47 | Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):0,1:Y)
|
---|
| 48 | ;
|
---|
| 49 | TASK ; Task off the job.
|
---|
| 50 | S ZTRTN="DQ^IVMUPUR",ZTSAVE("IVMYR")="",ZTIO=""
|
---|
| 51 | S ZTDESC="IVM - PURGE IVM TRANSMISSION RECORDS"
|
---|
| 52 | D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
|
---|
| 53 | K ZTSK
|
---|
| 54 | Q
|
---|
| 55 | ;
|
---|
| 56 | ;
|
---|
| 57 | ;
|
---|
| 58 | DQ ; Tasked entry point to purge transmission data.
|
---|
| 59 | ; Input: IVMYR -- Income year for which to purge data
|
---|
| 60 | ;
|
---|
| 61 | S (IVMCNTT,IVMCNTV,IVMCNTP)=0
|
---|
| 62 | D NOW^%DTC S IVMSTART=%
|
---|
| 63 | ;
|
---|
| 64 | ; - do the purge and collect statistics
|
---|
| 65 | S DFN="" F S DFN=$O(^IVM(301.5,"AYR",IVMYR,DFN)) Q:'DFN D
|
---|
| 66 | .S IVMDA=0 F S IVMDA=$O(^IVM(301.5,"AYR",IVMYR,DFN,IVMDA)) Q:'IVMDA D
|
---|
| 67 | ..S IVMCNTT=IVMCNTT+1
|
---|
| 68 | ..Q:'$P($G(^IVM(301.5,IVMDA,0)),"^",4) ; case is still active
|
---|
| 69 | ..S IVMCNTV=IVMCNTV+1
|
---|
| 70 | ..;
|
---|
| 71 | ..; - delete all transmissions for the closed case
|
---|
| 72 | ..S IVMTR=0 F S IVMTR=$O(^IVM(301.6,"B",IVMDA,IVMTR)) Q:'IVMTR D
|
---|
| 73 | ...S IVMCNTP=IVMCNTP+1
|
---|
| 74 | ...S DIK="^IVM(301.6,",DA=IVMTR D ^DIK
|
---|
| 75 | ;
|
---|
| 76 | D NOW^%DTC S IVMEND=%
|
---|
| 77 | ;
|
---|
| 78 | ; - send a mail message with the results
|
---|
| 79 | S XMSUB="COMPLETED PURGE OF IVM TRANSMISSION RECORDS"
|
---|
| 80 | S XMDUZ="INCOME VERIFICATION MATCH PACKAGE"
|
---|
| 81 | S XMTEXT="IVMTXT("
|
---|
| 82 | S XMY(DUZ)=""
|
---|
| 83 | ;
|
---|
| 84 | S IVMTXT(1)="The purge of data from the IVM TRANSMISSIONS (#301.6) file has completed."
|
---|
| 85 | S IVMTXT(2)=" "
|
---|
| 86 | S IVMTXT(3)=" Job Start Date/Time: "_$$DAT2^IVMUFNC4(IVMSTART)
|
---|
| 87 | S IVMTXT(4)=" Job End Date/Time: "_$$DAT2^IVMUFNC4(IVMEND)
|
---|
| 88 | S IVMTXT(5)=" "
|
---|
| 89 | S IVMTXT(6)=" "
|
---|
| 90 | S IVMTXT(7)=" Income Year: "_($E(IVMYR,1,3)+1700)
|
---|
| 91 | S IVMTXT(8)=" "
|
---|
| 92 | S IVMTXT(9)=" Total number of case file records checked: "_IVMCNTT
|
---|
| 93 | S IVMTXT(10)=" Number of closed case records found: "_IVMCNTV
|
---|
| 94 | S IVMTXT(11)=" Number of IVM TRANSMISSION records deleted: "_IVMCNTP
|
---|
| 95 | ;
|
---|
| 96 | ; - deliver and quit
|
---|
| 97 | D ^XMD
|
---|
| 98 | ;
|
---|
| 99 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 100 | K DA,DFN,DIK,IVMSTART,IVMEND,IVMYR,IVMDA,IVMTR,IVMTXT,IVMCNTT,IVMCNTP,IVMCNTV
|
---|
| 101 | K XMSUB,XMDUZ,XMY,XMTEXT
|
---|
| 102 | Q
|
---|