|
Last change
on this file since 1000 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
645 bytes
|
| Rev | Line | |
|---|
| [613] | 1 | IBQLPRG ;LEB/MRY - PURGE UMR FILE AFTER ROLLUP ; 22-APR-95
|
|---|
| 2 | ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | N DIR,DIK,DA
|
|---|
| 6 | ; --
|
|---|
| 7 | W !,"Purge Rollup Data"
|
|---|
| 8 | S DIR(0)="SA^L:LOCAL;A:ALL",DIR("A")="Purge Local or ALL: ",DIR("B")="ALL" D ^DIR G:$D(DUOUT)!($D(DTOUT)) END
|
|---|
| 9 | S IBDNLD=Y
|
|---|
| 10 | S ZTRTN="PURGE^IBQLPRG",ZTDESC="IBQ - LOCAL PURGE ",ZTSAVE("IBDNLD")="",ZTIO=""
|
|---|
| 11 | D ^%ZTLOAD G END
|
|---|
| 12 | ;
|
|---|
| 13 | PURGE ; -- Purge entries
|
|---|
| 14 | S DIK="^IBQ(538,"
|
|---|
| 15 | S IBTRN=0 F S IBTRN=$O(^IBQ(538,IBTRN)) Q:'IBTRN D
|
|---|
| 16 | .I IBDNLD="L" Q:$P(^IBQ(538,IBTRN,1),"^",6)'="L"
|
|---|
| 17 | .S DA=IBTRN D ^DIK
|
|---|
| 18 | Q
|
|---|
| 19 | END K IBDNLD,IBTRN Q
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
