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

PRCGARCH.m

Go to the documentation of this file.
  1. PRCGARCH ;WIRMFO@ALTOONA/CTB CLEAR FILE 443.9 ;12/10/97 9:51 AM
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. N PERCENT,MIN,SEC,TIME,DX,DY,HOURS,TREC,LREC,LINE,DA,LASTENT,XPOS,A,BTIME,XCOUNT,COUNT
  1. S TREC=$P(^PRC(443.9,0),"^",4)
  1. QUIT:TREC=0
  1. S MESSAGE="CLEARING FILE 443.9"
  1. D BEGIN^PRCGU
  1. S DA=0,LASTENT=0,BTIME=$P($H,",",2),XCOUNT=0
  1. D PERCENT^PRCGU
  1. F D S XCOUNT=XCOUNT+COUNT D:'$D(ZTQUEUED) PERCENT^PRCGU Q:('DA)!($D(UPOUT))
  1. . F COUNT=1:1:LREC S DA=$O(^PRC(443.9,DA)) Q:'DA D R X:0 I X["^" S UPOUT=1 W !!!,"Option Terminated.",*7 QUIT
  1. . . I '$D(^PRC(442,DA,0)) D REMOVE QUIT
  1. . . I $P(^PRC(442,DA,0),"-")=PRC("SITE") D REMOVE
  1. . . S LASTENT=DA
  1. . . QUIT
  1. . QUIT
  1. S $P(^PRC(443.9,0),"^",3)=LASTENT
  1. D END^PRCGU
  1. QUIT
  1. REMOVE ;Remove one entry from 443.9
  1. N X,DIK
  1. S DIK="^PRC(443.9," D ^DIK
  1. QUIT