| 1 | IBCNBPG ;ALB/ARH-Ins Buffer: Option Purge stub entries ;1 Jun 97
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PURGE ;
|
|---|
| 6 | N X,Y,DIR,DIRUT,DUOUT,IBX,IBDBDT
|
|---|
| 7 | ;
|
|---|
| 8 | W @IOF,!!,?29,"INSURANCE BUFFER PURGE",!
|
|---|
| 9 | W !!,?3,"This option will purge Buffer file records Processed before a given date."
|
|---|
| 10 | W !!,?3,"When a Buffer record is Processed a stub entry remains in the Buffer file"
|
|---|
| 11 | W !,?3,"for tracking and reporting purposes. This option deletes all stub entries"
|
|---|
| 12 | W !,?3,"of Buffer records processed at least a year ago. Once a record is purged,"
|
|---|
| 13 | W !,?3,"it can not be retrieved and will no longer be included in Buffer reports."
|
|---|
| 14 | W !,?3,"To maintain a record of the Buffer activity, consider printing the Buffer"
|
|---|
| 15 | W !,?3,"reports for the date range you are going to be purging.",!!
|
|---|
| 16 | ;
|
|---|
| 17 | DATE ;
|
|---|
| 18 | S IBX=$$FMADD^XLFDT(DT,-365)
|
|---|
| 19 | S DIR("?",1)="All Buffer records that were Processed before the selected date will be deleted."
|
|---|
| 20 | S DIR("?",2)="A minimum of 1 year of Buffer records is maintained on line, therefore"
|
|---|
| 21 | S DIR("?",3)="the latest selectable date is 1 year ago.",DIR("?",4)=" "
|
|---|
| 22 | S DIR("?")="Enter a date on or before "_$$FMTE^XLFDT(IBX)_" or '^' to exit."
|
|---|
| 23 | S DIR("A")="Purge Buffer Records Processed Before",DIR("B")=$$FMTE^XLFDT(IBX)
|
|---|
| 24 | S DIR(0)="DO^:"_IBX_":EX" D ^DIR K DIR S IBDBDT=+Y I Y'?7N!(Y>IBX)!($D(DIRUT)) Q
|
|---|
| 25 | ;
|
|---|
| 26 | W !!
|
|---|
| 27 | OK ;
|
|---|
| 28 | S DIR("?",1)="All Buffer records that were Processed before the selected date will be deleted.",DIR("?",2)=" "
|
|---|
| 29 | S DIR("?")="Enter Yes to continue the Purge. Enter No to stop the process before deleting any Buffer records."
|
|---|
| 30 | S DIR("A")="Ok to Purge Buffer records Processed before "_$$FMTE^XLFDT(IBDBDT)
|
|---|
| 31 | S DIR(0)="YO" D ^DIR I Y'=1 Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | QUEUE ;
|
|---|
| 35 | S ZTDESC="Purge Insurance Buffer",ZTRTN="DELETE^IBCNBPG",ZTSAVE("IBDBDT")="",ZTIO="",ZTDTH=DT_".20" D ^%ZTLOAD
|
|---|
| 36 | I $D(ZTSK) W !!,"Purge of Insurance Buffer queued for this evening at 8:00pm."
|
|---|
| 37 | ;
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | DELETE ; delete all processed buffer entries older than a specified date, date must be 1 year or more ago
|
|---|
| 41 | ; QUEUED portion of PURGE OPTION
|
|---|
| 42 | N IBEDT,IBBUFDA,IBB0,IBSTAT,IBPDT,DA,DIK,X,Y
|
|---|
| 43 | ;
|
|---|
| 44 | I $G(IBDBDT)'?7N!($G(IBDBDT)'<$$FMADD^XLFDT(DT,-364)) Q
|
|---|
| 45 | ;
|
|---|
| 46 | S IBEDT=0 F S IBEDT=$O(^IBA(355.33,"B",IBEDT)) Q:'IBEDT!(IBEDT>IBDBDT) D
|
|---|
| 47 | . S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"B",IBEDT,IBBUFDA)) Q:'IBBUFDA D
|
|---|
| 48 | .. S IBB0=^IBA(355.33,IBBUFDA,0)
|
|---|
| 49 | .. S IBSTAT=$P(IBB0,U,4) I IBSTAT'="A",IBSTAT'="R" Q
|
|---|
| 50 | .. S IBPDT=$P(IBB0,U,5) I IBPDT'<IBDBDT Q
|
|---|
| 51 | .. ;
|
|---|
| 52 | .. S DA=IBBUFDA,DIK="^IBA(355.33," D ^DIK K DIK,DA
|
|---|
| 53 | ;
|
|---|
| 54 | Q
|
|---|
