source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUPUR.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IVMUPUR ;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 ;
5EN ; 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 ;
20SEL ; - 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 ;
29ENQ K IVMPYR,IVMYR
30 Q
31 ;
32 ;
33NODUZ() ; 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 ;
40OKAY() ; 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 ;
49TASK ; 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 ;
58DQ ; 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
Note: See TracBrowser for help on using the repository browser.