PRCGARCH ;WIRMFO@ALTOONA/CTB CLEAR FILE 443.9 ;12/10/97 9:51 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
N PERCENT,MIN,SEC,TIME,DX,DY,HOURS,TREC,LREC,LINE,DA,LASTENT,XPOS,A,BTIME,XCOUNT,COUNT
S TREC=$P(^PRC(443.9,0),"^",4)
QUIT:TREC=0
S MESSAGE="CLEARING FILE 443.9"
D BEGIN^PRCGU
S DA=0,LASTENT=0,BTIME=$P($H,",",2),XCOUNT=0
D PERCENT^PRCGU
F D S XCOUNT=XCOUNT+COUNT D:'$D(ZTQUEUED) PERCENT^PRCGU Q:('DA)!($D(UPOUT))
. 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
. . I '$D(^PRC(442,DA,0)) D REMOVE QUIT
. . I $P(^PRC(442,DA,0),"-")=PRC("SITE") D REMOVE
. . S LASTENT=DA
. . QUIT
. QUIT
S $P(^PRC(443.9,0),"^",3)=LASTENT
D END^PRCGU
QUIT
REMOVE ;Remove one entry from 443.9
N X,DIK
S DIK="^PRC(443.9," D ^DIK
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCGARCH 883 printed Dec 13, 2024@02:04:47 Page 2
PRCGARCH ;WIRMFO@ALTOONA/CTB CLEAR FILE 443.9 ;12/10/97 9:51 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 NEW PERCENT,MIN,SEC,TIME,DX,DY,HOURS,TREC,LREC,LINE,DA,LASTENT,XPOS,A,BTIME,XCOUNT,COUNT
+3 SET TREC=$PIECE(^PRC(443.9,0),"^",4)
+4 if TREC=0
QUIT
+5 SET MESSAGE="CLEARING FILE 443.9"
+6 DO BEGIN^PRCGU
+7 SET DA=0
SET LASTENT=0
SET BTIME=$PIECE($HOROLOG,",",2)
SET XCOUNT=0
+8 DO PERCENT^PRCGU
+9 FOR
Begin DoDot:1
+10 FOR COUNT=1:1:LREC
SET DA=$ORDER(^PRC(443.9,DA))
if 'DA
QUIT
Begin DoDot:2
+11 IF '$DATA(^PRC(442,DA,0))
DO REMOVE
QUIT
+12 IF $PIECE(^PRC(442,DA,0),"-")=PRC("SITE")
DO REMOVE
+13 SET LASTENT=DA
+14 QUIT
End DoDot:2
READ X:0
IF X["^"
SET UPOUT=1
WRITE !!!,"Option Terminated.",*7
QUIT
+15 QUIT
End DoDot:1
SET XCOUNT=XCOUNT+COUNT
if '$DATA(ZTQUEUED)
DO PERCENT^PRCGU
if ('DA)!($DATA(UPOUT))
QUIT
+16 SET $PIECE(^PRC(443.9,0),"^",3)=LASTENT
+17 DO END^PRCGU
+18 QUIT
REMOVE ;Remove one entry from 443.9
+1 NEW X,DIK
+2 SET DIK="^PRC(443.9,"
DO ^DIK
+3 QUIT
