| 1 | IBCNEKIT ;DAOU/ESG - PURGE IIV DATA FILES ;11-JUL-2002
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,271,316**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine handles the purging of the IIV data stored in the
|
|---|
| 6 | ; IIV Transmission Queue file (#365.1) and in the IIV Response file (#365).
|
|---|
| 7 | ; User can pick a date range for the purge. Data created within 6 months
|
|---|
| 8 | ; cannot be purged. The actual global kills are done by a background
|
|---|
| 9 | ; task after hours (8:00pm).
|
|---|
| 10 | ;
|
|---|
| 11 | EN ;
|
|---|
| 12 | NEW STOP,BEGDT,ENDDT,STATLIST
|
|---|
| 13 | D INIT I STOP G EXIT ; initialize/calculate default dates
|
|---|
| 14 | D BEGDT I STOP G EXIT ; user interface for beginning date
|
|---|
| 15 | D ENDDT I STOP G EXIT ; user interface for ending date
|
|---|
| 16 | D CONFIRM I STOP G EXIT ; confirmation message/final check
|
|---|
| 17 | D QUEUE ; queuing process
|
|---|
| 18 | EXIT ;
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | PURGE ; This procedure is queued to run in the background and does the
|
|---|
| 22 | ; actual purging. Variables available from the TaskMan call are:
|
|---|
| 23 | ;
|
|---|
| 24 | ; STATLIST = list of statuses that are OK to purge
|
|---|
| 25 | ; BEGDT = beginning date for purging
|
|---|
| 26 | ; ENDDT = ending date for purging
|
|---|
| 27 | ;
|
|---|
| 28 | N NOW,CACHE
|
|---|
| 29 | S NOW=$$NOW^XLFDT
|
|---|
| 30 | ;
|
|---|
| 31 | ; Check to see if O/C is Cache, if so then cache specific journal code can be used to
|
|---|
| 32 | ; enable/disable/enable journaling
|
|---|
| 33 | S CACHE=0
|
|---|
| 34 | I $P(^%ZOSF("OS"),U)="OpenM-NT" S CACHE=1
|
|---|
| 35 | ;
|
|---|
| 36 | ; Retain ^XTMP for seven days
|
|---|
| 37 | I '$D(^XTMP("IBCNEKIT")) S ^XTMP("IBCNEKIT",0)=U_NOW_U_"Journaling status"
|
|---|
| 38 | S $P(^XTMP("IBCNEKIT",0),U)=$$FMADD^XLFDT(NOW,7)
|
|---|
| 39 | ;
|
|---|
| 40 | I 'CACHE D
|
|---|
| 41 | . S ^XTMP("IBCNEKIT",NOW,"STEP 1: NO ACTION")="An O/S conflict prevents journaling from disabling."
|
|---|
| 42 | E D
|
|---|
| 43 | . ; Set error trap and disable journaling for this one process
|
|---|
| 44 | . NEW $ETRAP,$ESTACK,STATUS
|
|---|
| 45 | . S $ETRAP="D TRAP^IBCNEKIT"
|
|---|
| 46 | . S STATUS=$$CURRENT^%NOJRN
|
|---|
| 47 | . S STATUS=$S(STATUS=1:"Enabled",1:"Disabled")
|
|---|
| 48 | . S ^XTMP("IBCNEKIT",NOW,"STEP 1: START")="Journaling for this process is "_STATUS_U_$$NOW^XLFDT
|
|---|
| 49 | . ;
|
|---|
| 50 | . D DISABLE^%NOJRN
|
|---|
| 51 | . S STATUS=$$CURRENT^%NOJRN
|
|---|
| 52 | . S STATUS=$S(STATUS=1:"Enabled",1:"Disabled")
|
|---|
| 53 | . S ^XTMP("IBCNEKIT",NOW,"STEP 2: DISABLE")="Journaling for this process is "_STATUS_U_$$NOW^XLFDT
|
|---|
| 54 | ;
|
|---|
| 55 | ;
|
|---|
| 56 | ; First loop through the IIV Transmission Queue file and delete all
|
|---|
| 57 | ; records in the date range whose status is in the list
|
|---|
| 58 | ;
|
|---|
| 59 | NEW DATE,TQIEN,TQS,HLIEN,DIK,DA,CNT
|
|---|
| 60 | S DATE=$O(^IBCN(365.1,"AE",BEGDT),-1),CNT=0
|
|---|
| 61 | F S DATE=$O(^IBCN(365.1,"AE",DATE)) Q:'DATE!($P(DATE,".",1)>ENDDT)!$G(ZTSTOP) S TQIEN=0 F S TQIEN=$O(^IBCN(365.1,"AE",DATE,TQIEN)) Q:'TQIEN D Q:$G(ZTSTOP)
|
|---|
| 62 | . S CNT=CNT+1
|
|---|
| 63 | . I $D(ZTQUEUED),CNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
|
|---|
| 64 | . S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4) ; trans queue status
|
|---|
| 65 | . I '$F(STATLIST,","_TQS_",") Q ; must be in the list
|
|---|
| 66 | . ;
|
|---|
| 67 | . ; loop through the HL7 messages multiple and kill any response
|
|---|
| 68 | . ; records that are found for this transmission queue entry
|
|---|
| 69 | . S HLIEN=0,DIK="^IBCN(365,"
|
|---|
| 70 | . F S HLIEN=$O(^IBCN(365.1,TQIEN,2,HLIEN)) Q:'HLIEN D
|
|---|
| 71 | .. S DA=$P($G(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3) I DA D ^DIK
|
|---|
| 72 | .. Q
|
|---|
| 73 | . ;
|
|---|
| 74 | . ; now we can kill the transmission queue entry itself
|
|---|
| 75 | . S DA=TQIEN,DIK="^IBCN(365.1," D ^DIK
|
|---|
| 76 | . Q
|
|---|
| 77 | ;
|
|---|
| 78 | ; Check for a stop request
|
|---|
| 79 | I $G(ZTSTOP) G PURGEX
|
|---|
| 80 | ;
|
|---|
| 81 | ; Now we must loop through the IIV Response file itself to purge any
|
|---|
| 82 | ; response records that do not have a corresponding transmission
|
|---|
| 83 | ; queue entry. These are the unsolicited responses. The status of
|
|---|
| 84 | ; these responses is always 'response received' so we don't need to
|
|---|
| 85 | ; check the status. For this loop, start from the very beginning of
|
|---|
| 86 | ; the file.
|
|---|
| 87 | ;
|
|---|
| 88 | S DATE="",DIK="^IBCN(365,",CNT=0
|
|---|
| 89 | F S DATE=$O(^IBCN(365,"AE",DATE)) Q:'DATE!($P(DATE,".",1)>ENDDT)!$G(ZTSTOP) S DA=0 F S DA=$O(^IBCN(365,"AE",DATE,DA)) Q:'DA D Q:$G(ZTSTOP)
|
|---|
| 90 | . S CNT=CNT+1
|
|---|
| 91 | . I $D(ZTQUEUED),CNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
|
|---|
| 92 | . ;
|
|---|
| 93 | . ; If there is a pointer to the transmission queue file, then we
|
|---|
| 94 | . ; should get out of this loop because the purpose of this section
|
|---|
| 95 | . ; is to purge those responses with no link to the transmission
|
|---|
| 96 | . ; queue file.
|
|---|
| 97 | . ;
|
|---|
| 98 | . I $P($G(^IBCN(365,DA,0)),U,5) Q
|
|---|
| 99 | . D ^DIK
|
|---|
| 100 | . Q
|
|---|
| 101 | PURGEX ;
|
|---|
| 102 | ; Turn journaling back on
|
|---|
| 103 | I CACHE D
|
|---|
| 104 | . D ENABLE^%NOJRN
|
|---|
| 105 | . S STATUS=$$CURRENT^%NOJRN
|
|---|
| 106 | . S STATUS=$S(STATUS=1:"Enabled",1:"Disabled")
|
|---|
| 107 | . S ^XTMP("IBCNEKIT",NOW,"STEP 3: COMPLETED")="Journaling for this process is "_STATUS_U_$$NOW^XLFDT
|
|---|
| 108 | ; Tell TaskManager to delete the task's record
|
|---|
| 109 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | TRAP ;
|
|---|
| 113 | ; Error trap code for Purge^IBCNEKIT that was called by TaskMan
|
|---|
| 114 | ; Re-Enable journaling before quitting this routine
|
|---|
| 115 | ;
|
|---|
| 116 | D ENABLE^%NOJRN
|
|---|
| 117 | S STATUS=$$CURRENT^%NOJRN
|
|---|
| 118 | S STATUS=$S(STATUS=1:"Enabled",1:"Disabled")
|
|---|
| 119 | S ^XTMP("IBCNEKIT",NOW,"STEP 3: ABORTED")="Journaling for this process is "_STATUS_U_$$NOW^XLFDT
|
|---|
| 120 | D ^%ZTER
|
|---|
| 121 | D UNWIND^%ZTER
|
|---|
| 122 | Q
|
|---|
| 123 | ;
|
|---|
| 124 | INIT ; This procedure calculates the default beginning and ending dates
|
|---|
| 125 | ; and displays screen messages about this option to the user.
|
|---|
| 126 | ;
|
|---|
| 127 | NEW DATE,FOUND,TQIEN,TQS,RPIEN,RPS
|
|---|
| 128 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 129 | ;
|
|---|
| 130 | S STOP=0
|
|---|
| 131 | ;
|
|---|
| 132 | ; This is the list of statuses that are OK to purge
|
|---|
| 133 | ; 3=Response Received
|
|---|
| 134 | ; 5=Communication Failure
|
|---|
| 135 | ; 7=Cancelled
|
|---|
| 136 | S STATLIST=",3,5,7,"
|
|---|
| 137 | ;
|
|---|
| 138 | ; Try to find a beginning date in the IIV Transmission Queue file
|
|---|
| 139 | S DATE="",FOUND=0,BEGDT=DT
|
|---|
| 140 | F S DATE=$O(^IBCN(365.1,"AE",DATE)) Q:'DATE!FOUND S TQIEN=0 F S TQIEN=$O(^IBCN(365.1,"AE",DATE,TQIEN)) Q:'TQIEN D Q:FOUND
|
|---|
| 141 | . S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4) ; status
|
|---|
| 142 | . I '$F(STATLIST,","_TQS_",") Q
|
|---|
| 143 | . S FOUND=1
|
|---|
| 144 | . S BEGDT=$P(DATE,".",1)
|
|---|
| 145 | . Q
|
|---|
| 146 | ;
|
|---|
| 147 | ; If not successful, try to find a beginning date in the IIV Response file.
|
|---|
| 148 | I 'FOUND D
|
|---|
| 149 | . S DATE=""
|
|---|
| 150 | . F S DATE=$O(^IBCN(365,"AE",DATE)) Q:'DATE!FOUND S RPIEN=0 F S RPIEN=$O(^IBCN(365,"AE",DATE,RPIEN)) Q:'RPIEN D Q:FOUND
|
|---|
| 151 | .. S RPS=$P($G(^IBCN(365,RPIEN,0)),U,6) ; status
|
|---|
| 152 | .. I '$F(STATLIST,","_RPS_",") Q
|
|---|
| 153 | .. S FOUND=1
|
|---|
| 154 | .. S BEGDT=$P(DATE,".",1)
|
|---|
| 155 | .. Q
|
|---|
| 156 | . Q
|
|---|
| 157 | ;
|
|---|
| 158 | ; default end date, Today minus 182 days (approx 6 months)
|
|---|
| 159 | S ENDDT=$$FMADD^XLFDT(DT,-182)
|
|---|
| 160 | ;
|
|---|
| 161 | I 'FOUND!(BEGDT>ENDDT) D S STOP=1 G INITX
|
|---|
| 162 | . W !!?5,"Purging of IIV data is not possible at this time."
|
|---|
| 163 | . I 'FOUND W !?5,"There are no entries in the file that are eligible to be",!?5,"purged or there is no data in the file."
|
|---|
| 164 | . E W !?5,"The oldest date in the file is ",$$FMTE^XLFDT(BEGDT,"5Z"),".",!?5,"Data cannot be purged unless it is at least 6 months old."
|
|---|
| 165 | . W ! S DIR(0)="E" D ^DIR K DIR
|
|---|
| 166 | . Q
|
|---|
| 167 | ;
|
|---|
| 168 | ; At this point, we know that there are some entries eligible for
|
|---|
| 169 | ; purging. Display a message to the user about this option.
|
|---|
| 170 | W @IOF
|
|---|
| 171 | W !?3,"Purge Electronic Insurance Identification and Verification (IIV) Data Files"
|
|---|
| 172 | W !!!," This option will allow you to purge data from the IIV Response File (#365)"
|
|---|
| 173 | W !," and the IIV Transmission Queue File (#365.1). The data must be at least six"
|
|---|
| 174 | W !," months old before it can be purged. Only insurance transactions that have a"
|
|---|
| 175 | W !," transmission status of ""Response Received"", ""Communication Failure"", or"
|
|---|
| 176 | W !," ""Cancelled"" may be purged. You will be allowed to select a date range for"
|
|---|
| 177 | W !," this purging. The default beginning date will be the date of the oldest"
|
|---|
| 178 | W !," eligible record in the system. The default ending date will be six months"
|
|---|
| 179 | W !," ago from today's date. You may modify this default date range. However, you"
|
|---|
| 180 | W !," may not select an ending date that is more recent than six months ago."
|
|---|
| 181 | W !!
|
|---|
| 182 | INITX ;
|
|---|
| 183 | Q
|
|---|
| 184 | ;
|
|---|
| 185 | BEGDT ; This procedure captures the beginning date from the user.
|
|---|
| 186 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 187 | S DIR(0)="DOA^"_BEGDT_":"_ENDDT_":AEX"
|
|---|
| 188 | S DIR("A")="Enter the purge begin date: "
|
|---|
| 189 | S DIR("B")=$$FMTE^XLFDT(BEGDT,"5Z")
|
|---|
| 190 | S DIR("?")="This response must be a date between "_$$FMTE^XLFDT(BEGDT,"5Z")_" and "_$$FMTE^XLFDT(ENDDT,"5Z")_"."
|
|---|
| 191 | D ^DIR K DIR
|
|---|
| 192 | I $D(DIRUT)!'Y S STOP=1 G BEGDTX
|
|---|
| 193 | S BEGDT=Y
|
|---|
| 194 | BEGDTX ;
|
|---|
| 195 | Q
|
|---|
| 196 | ;
|
|---|
| 197 | ENDDT ; This procedure captures the ending date from the user.
|
|---|
| 198 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 199 | W !
|
|---|
| 200 | S DIR(0)="DOA^"_BEGDT_":"_ENDDT_":AEX"
|
|---|
| 201 | S DIR("A")=" Enter the purge end date: "
|
|---|
| 202 | S DIR("B")=$$FMTE^XLFDT(ENDDT,"5Z")
|
|---|
| 203 | S DIR("?")="This response must be a date between "_$$FMTE^XLFDT(BEGDT,"5Z")_" and "_$$FMTE^XLFDT(ENDDT,"5Z")_"."
|
|---|
| 204 | D ^DIR K DIR
|
|---|
| 205 | I $D(DIRUT)!'Y S STOP=1 G ENDDTX
|
|---|
| 206 | S ENDDT=Y
|
|---|
| 207 | ENDDTX ;
|
|---|
| 208 | Q
|
|---|
| 209 | ;
|
|---|
| 210 | CONFIRM ; This procedure displays a confirmation message to the user and
|
|---|
| 211 | ; asks if it is OK to proceed with the purge.
|
|---|
| 212 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 213 | W !!!," You want to purge all IIV data created between "
|
|---|
| 214 | W $$FMTE^XLFDT(BEGDT,"5Z")," and ",$$FMTE^XLFDT(ENDDT,"5Z"),"."
|
|---|
| 215 | W !
|
|---|
| 216 | S DIR(0)="YO",DIR("A")=" OK to continue"
|
|---|
| 217 | S DIR("B")="NO"
|
|---|
| 218 | D ^DIR K DIR
|
|---|
| 219 | I 'Y S STOP=1
|
|---|
| 220 | CONFX ;
|
|---|
| 221 | Q
|
|---|
| 222 | ;
|
|---|
| 223 | QUEUE ; This procedure queues the purge process for later at night.
|
|---|
| 224 | ; The concept for queuing the purge came from the insurance buffer
|
|---|
| 225 | ; purge routine, IBCNBPG. That purge process is also hard-coded to
|
|---|
| 226 | ; be run at 8:00 PM just like this one is.
|
|---|
| 227 | ;
|
|---|
| 228 | NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
|
|---|
| 229 | NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 230 | S ZTRTN="PURGE^IBCNEKIT" ; TaskMan task entry point
|
|---|
| 231 | S ZTDESC="Purge IIV Data" ; Task description
|
|---|
| 232 | S ZTDTH=DT_".20" ; start it at 8:00 PM tonight
|
|---|
| 233 | S ZTIO=""
|
|---|
| 234 | S ZTSAVE("BEGDT")=""
|
|---|
| 235 | S ZTSAVE("ENDDT")=""
|
|---|
| 236 | S ZTSAVE("STATLIST")=""
|
|---|
| 237 | D ^%ZTLOAD
|
|---|
| 238 | I $G(ZTSK) W !!," Task# ",ZTSK," has been scheduled to purge the IIV data tonight at 8:00 PM."
|
|---|
| 239 | E W !!," TaskManager could not schedule this task.",!," Contact IRM for technical assistance."
|
|---|
| 240 | W ! S DIR(0)="E" D ^DIR K DIR
|
|---|
| 241 | QUEUEX ;
|
|---|
| 242 | Q
|
|---|
