source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCGARCH.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 859 bytes
Line 
1PRCGARCH ;WIRMFO@ALTOONA/CTB CLEAR FILE 443.9 ;12/10/97 9:51 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 N PERCENT,MIN,SEC,TIME,DX,DY,HOURS,TREC,LREC,LINE,DA,LASTENT,XPOS,A,BTIME,XCOUNT,COUNT
5 S TREC=$P(^PRC(443.9,0),"^",4)
6 QUIT:TREC=0
7 S MESSAGE="CLEARING FILE 443.9"
8 D BEGIN^PRCGU
9 S DA=0,LASTENT=0,BTIME=$P($H,",",2),XCOUNT=0
10 D PERCENT^PRCGU
11 F D S XCOUNT=XCOUNT+COUNT D:'$D(ZTQUEUED) PERCENT^PRCGU Q:('DA)!($D(UPOUT))
12 . 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
13 . . I '$D(^PRC(442,DA,0)) D REMOVE QUIT
14 . . I $P(^PRC(442,DA,0),"-")=PRC("SITE") D REMOVE
15 . . S LASTENT=DA
16 . . QUIT
17 . QUIT
18 S $P(^PRC(443.9,0),"^",3)=LASTENT
19 D END^PRCGU
20 QUIT
21REMOVE ;Remove one entry from 443.9
22 N X,DIK
23 S DIK="^PRC(443.9," D ^DIK
24 QUIT
Note: See TracBrowser for help on using the repository browser.