IVMUPUR ;ALB/CPM - PURGE IVM TRANSMISSION RECORDS ; 22-MAY-94
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ; Queue job to purge IVM Transmissions from file #301.6
;
I $$NODUZ() G ENQ
;
S IVMPYR=1699+$E(DT,1,3)
;
W !!,"This option is used to purge data from the IVM TRANSMISSIONS (#301.6) file."
W !,"Entries in this file will only be purged for corresponding case records"
W !,"in the IVM PATIENT (#301.5) file which have been closed."
;
W !!,"You will purge transmission records for an entire income year's worth of cases."
W !,"However, you must select an income year prior to the year which corresponds"
W !,"to the current year's Means Tests. Since this year's Means Tests are based"
W !,"on ",IVMPYR," income, you must select an income year prior to ",IVMPYR,".",!!
;
SEL ; - select an income year prior to that which current MT's are based
S %DT("A")="Select the Income Year for which to purge transmissions: "
S %DT(0)=2860000,%DT="AE" D ^%DT K %DT G:$D(DTOUT)!(Y<0) ENQ
I $E(Y,1,3)+1700'<IVMPYR W !!,"Invalid year entered. Enter a year prior to ",IVMPYR,".",! G SEL
S IVMYR=$E(Y,1,3)_"0000"
;
; - okay to task off the job?
I $$OKAY D TASK
;
ENQ K IVMPYR,IVMYR
Q
;
;
NODUZ() ; Check for the existence of DUZ
; Input: NONE
; Output: 0 -- has DUZ, 1 -- no DUZ
N Y
I '$G(DUZ) S Y=1 W !!,"Your DUZ code must be defined in order to use this option.",!
Q +$G(Y)
;
OKAY() ; Okay to queue this job?
; Input: NONE
; Output: 0 -- No, not okay, 1 -- Yes, okay to continue
N DIR,DIRUT,DUOUT,DTOUT,Y
S DIR(0)="Y",DIR("A")="Is it okay to queue this job"
S DIR("?",1)="Enter: 'Y' if you wish to task off this job, or"
S DIR("?")=" 'N' or '^' to quit this option." W ! D ^DIR
Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):0,1:Y)
;
TASK ; Task off the job.
S ZTRTN="DQ^IVMUPUR",ZTSAVE("IVMYR")="",ZTIO=""
S ZTDESC="IVM - PURGE IVM TRANSMISSION RECORDS"
D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
K ZTSK
Q
;
;
;
DQ ; Tasked entry point to purge transmission data.
; Input: IVMYR -- Income year for which to purge data
;
S (IVMCNTT,IVMCNTV,IVMCNTP)=0
D NOW^%DTC S IVMSTART=%
;
; - do the purge and collect statistics
S DFN="" F S DFN=$O(^IVM(301.5,"AYR",IVMYR,DFN)) Q:'DFN D
.S IVMDA=0 F S IVMDA=$O(^IVM(301.5,"AYR",IVMYR,DFN,IVMDA)) Q:'IVMDA D
..S IVMCNTT=IVMCNTT+1
..Q:'$P($G(^IVM(301.5,IVMDA,0)),"^",4) ; case is still active
..S IVMCNTV=IVMCNTV+1
..;
..; - delete all transmissions for the closed case
..S IVMTR=0 F S IVMTR=$O(^IVM(301.6,"B",IVMDA,IVMTR)) Q:'IVMTR D
...S IVMCNTP=IVMCNTP+1
...S DIK="^IVM(301.6,",DA=IVMTR D ^DIK
;
D NOW^%DTC S IVMEND=%
;
; - send a mail message with the results
S XMSUB="COMPLETED PURGE OF IVM TRANSMISSION RECORDS"
S XMDUZ="INCOME VERIFICATION MATCH PACKAGE"
S XMTEXT="IVMTXT("
S XMY(DUZ)=""
;
S IVMTXT(1)="The purge of data from the IVM TRANSMISSIONS (#301.6) file has completed."
S IVMTXT(2)=" "
S IVMTXT(3)=" Job Start Date/Time: "_$$DAT2^IVMUFNC4(IVMSTART)
S IVMTXT(4)=" Job End Date/Time: "_$$DAT2^IVMUFNC4(IVMEND)
S IVMTXT(5)=" "
S IVMTXT(6)=" "
S IVMTXT(7)=" Income Year: "_($E(IVMYR,1,3)+1700)
S IVMTXT(8)=" "
S IVMTXT(9)=" Total number of case file records checked: "_IVMCNTT
S IVMTXT(10)=" Number of closed case records found: "_IVMCNTV
S IVMTXT(11)=" Number of IVM TRANSMISSION records deleted: "_IVMCNTP
;
; - deliver and quit
D ^XMD
;
I $D(ZTQUEUED) S ZTREQ="@"
K DA,DFN,DIK,IVMSTART,IVMEND,IVMYR,IVMDA,IVMTR,IVMTXT,IVMCNTT,IVMCNTP,IVMCNTV
K XMSUB,XMDUZ,XMY,XMTEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUPUR 3879 printed Apr 09, 2024@21:02:06 Page 2
IVMUPUR ;ALB/CPM - PURGE IVM TRANSMISSION RECORDS ; 22-MAY-94
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EN ; Queue job to purge IVM Transmissions from file #301.6
+1 ;
+2 IF $$NODUZ()
GOTO ENQ
+3 ;
+4 SET IVMPYR=1699+$EXTRACT(DT,1,3)
+5 ;
+6 WRITE !!,"This option is used to purge data from the IVM TRANSMISSIONS (#301.6) file."
+7 WRITE !,"Entries in this file will only be purged for corresponding case records"
+8 WRITE !,"in the IVM PATIENT (#301.5) file which have been closed."
+9 ;
+10 WRITE !!,"You will purge transmission records for an entire income year's worth of cases."
+11 WRITE !,"However, you must select an income year prior to the year which corresponds"
+12 WRITE !,"to the current year's Means Tests. Since this year's Means Tests are based"
+13 WRITE !,"on ",IVMPYR," income, you must select an income year prior to ",IVMPYR,".",!!
+14 ;
SEL ; - select an income year prior to that which current MT's are based
+1 SET %DT("A")="Select the Income Year for which to purge transmissions: "
+2 SET %DT(0)=2860000
SET %DT="AE"
DO ^%DT
KILL %DT
if $DATA(DTOUT)!(Y<0)
GOTO ENQ
+3 IF $EXTRACT(Y,1,3)+1700'<IVMPYR
WRITE !!,"Invalid year entered. Enter a year prior to ",IVMPYR,".",!
GOTO SEL
+4 SET IVMYR=$EXTRACT(Y,1,3)_"0000"
+5 ;
+6 ; - okay to task off the job?
+7 IF $$OKAY
DO TASK
+8 ;
ENQ KILL IVMPYR,IVMYR
+1 QUIT
+2 ;
+3 ;
NODUZ() ; Check for the existence of DUZ
+1 ; Input: NONE
+2 ; Output: 0 -- has DUZ, 1 -- no DUZ
+3 NEW Y
+4 IF '$GET(DUZ)
SET Y=1
WRITE !!,"Your DUZ code must be defined in order to use this option.",!
+5 QUIT +$GET(Y)
+6 ;
OKAY() ; Okay to queue this job?
+1 ; Input: NONE
+2 ; Output: 0 -- No, not okay, 1 -- Yes, okay to continue
+3 NEW DIR,DIRUT,DUOUT,DTOUT,Y
+4 SET DIR(0)="Y"
SET DIR("A")="Is it okay to queue this job"
+5 SET DIR("?",1)="Enter: 'Y' if you wish to task off this job, or"
+6 SET DIR("?")=" 'N' or '^' to quit this option."
WRITE !
DO ^DIR
+7 QUIT $SELECT($DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT)):0,1:Y)
+8 ;
TASK ; Task off the job.
+1 SET ZTRTN="DQ^IVMUPUR"
SET ZTSAVE("IVMYR")=""
SET ZTIO=""
+2 SET ZTDESC="IVM - PURGE IVM TRANSMISSION RECORDS"
+3 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+4 KILL ZTSK
+5 QUIT
+6 ;
+7 ;
+8 ;
DQ ; Tasked entry point to purge transmission data.
+1 ; Input: IVMYR -- Income year for which to purge data
+2 ;
+3 SET (IVMCNTT,IVMCNTV,IVMCNTP)=0
+4 DO NOW^%DTC
SET IVMSTART=%
+5 ;
+6 ; - do the purge and collect statistics
+7 SET DFN=""
FOR
SET DFN=$ORDER(^IVM(301.5,"AYR",IVMYR,DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 SET IVMDA=0
FOR
SET IVMDA=$ORDER(^IVM(301.5,"AYR",IVMYR,DFN,IVMDA))
if 'IVMDA
QUIT
Begin DoDot:2
+9 SET IVMCNTT=IVMCNTT+1
+10 ; case is still active
if '$PIECE($GET(^IVM(301.5,IVMDA,0)),"^",4)
QUIT
+11 SET IVMCNTV=IVMCNTV+1
+12 ;
+13 ; - delete all transmissions for the closed case
+14 SET IVMTR=0
FOR
SET IVMTR=$ORDER(^IVM(301.6,"B",IVMDA,IVMTR))
if 'IVMTR
QUIT
Begin DoDot:3
+15 SET IVMCNTP=IVMCNTP+1
+16 SET DIK="^IVM(301.6,"
SET DA=IVMTR
DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 DO NOW^%DTC
SET IVMEND=%
+19 ;
+20 ; - send a mail message with the results
+21 SET XMSUB="COMPLETED PURGE OF IVM TRANSMISSION RECORDS"
+22 SET XMDUZ="INCOME VERIFICATION MATCH PACKAGE"
+23 SET XMTEXT="IVMTXT("
+24 SET XMY(DUZ)=""
+25 ;
+26 SET IVMTXT(1)="The purge of data from the IVM TRANSMISSIONS (#301.6) file has completed."
+27 SET IVMTXT(2)=" "
+28 SET IVMTXT(3)=" Job Start Date/Time: "_$$DAT2^IVMUFNC4(IVMSTART)
+29 SET IVMTXT(4)=" Job End Date/Time: "_$$DAT2^IVMUFNC4(IVMEND)
+30 SET IVMTXT(5)=" "
+31 SET IVMTXT(6)=" "
+32 SET IVMTXT(7)=" Income Year: "_($EXTRACT(IVMYR,1,3)+1700)
+33 SET IVMTXT(8)=" "
+34 SET IVMTXT(9)=" Total number of case file records checked: "_IVMCNTT
+35 SET IVMTXT(10)=" Number of closed case records found: "_IVMCNTV
+36 SET IVMTXT(11)=" Number of IVM TRANSMISSION records deleted: "_IVMCNTP
+37 ;
+38 ; - deliver and quit
+39 DO ^XMD
+40 ;
+41 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+42 KILL DA,DFN,DIK,IVMSTART,IVMEND,IVMYR,IVMDA,IVMTR,IVMTXT,IVMCNTT,IVMCNTP,IVMCNTV
+43 KILL XMSUB,XMDUZ,XMY,XMTEXT
+44 QUIT
