Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBQLPRG

IBQLPRG.m

Go to the documentation of this file.
  1. IBQLPRG ;LEB/MRY - PURGE UMR FILE AFTER ROLLUP ; 22-APR-95
  1. ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. N DIR,DIK,DA
  1. ; --
  1. W !,"Purge Rollup Data"
  1. 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
  1. S IBDNLD=Y
  1. S ZTRTN="PURGE^IBQLPRG",ZTDESC="IBQ - LOCAL PURGE ",ZTSAVE("IBDNLD")="",ZTIO=""
  1. D ^%ZTLOAD G END
  1. ;
  1. PURGE ; -- Purge entries
  1. S DIK="^IBQ(538,"
  1. S IBTRN=0 F S IBTRN=$O(^IBQ(538,IBTRN)) Q:'IBTRN D
  1. .I IBDNLD="L" Q:$P(^IBQ(538,IBTRN,1),"^",6)'="L"
  1. .S DA=IBTRN D ^DIK
  1. Q
  1. END K IBDNLD,IBTRN Q