IVMUPUR.m

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 ---IVMUPUR   3879     printed  Mar 13, 2025@21:07:07                                                                                                                                                                                                     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