41 lines
2.3 KiB
Mathematica
41 lines
2.3 KiB
Mathematica
|
PRCFPR2 ;WISC/LDB-Purge stacked document listing ;7/13/93 3:10 PM
|
||
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
PURGE ;Allow deletion from file 421.8 by date
|
||
|
|
;
|
||
|
|
N DIR,DIC,DIE,DIK,X,Y
|
||
|
|
S PRCF("X")="AS" D ^PRCFSITE Q:'%
|
||
|
|
I '$D(^PRC(421.8,"AD")) W !,"THERE ARE NO PRINTED RECORDS TO PURGE" Q
|
||
|
|
S DIR(0)="YO",DIR("B")="NO",DIR("A")="Purge all PRINTED documents from the listing" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S ALL=Y G:Y DEL
|
||
|
|
S DIR("A")="Begin with which date",DIR("?",1)="Time is optional.",DIR("?")=" Enter the date to start range-",DIR("B")=$$DATE($O(^PRC(421.8,"AD",0)))
|
||
|
|
S DIR(0)="DO^"_$O(^PRC(421.8,"AD",0))_":"_(DT+.9999)_":EXT" D ^DIR S:'Y DATE1=$O(^PRC(421.8,"AD",0)) G:$D(DTOUT)!$D(DUOUT) EXIT
|
||
|
|
S:Y DATE1=Y
|
||
|
|
W ! K DIR S DIR("A")="End with which date",DIR("?",1)="Time is optional.",DIR("?")=" Enter the date that will end the range-"
|
||
|
|
D NOW^%DTC S %=$E(%,1,12) S DIR(0)="DO^"_DATE1_":"_(DT+.9999)_":EXT",DIR("B")=$$DATE(%) D ^DIR G:$D(DIRUT) EXIT S DATE2=Y,Y=0
|
||
|
|
I 'ALL,'DATE1 W !!,"NO RECORDS WERE DELETED" G EXIT
|
||
|
|
DEL S DAT=$S('ALL:(DATE1-.0001),1:0),DATE2=$S(ALL:9999999.99,'ALL&$P(DATE2,"."):DATE2,'ALL&'$P(DATE2,"."):DATE2_".9999",1:9999999.99)
|
||
|
|
F S DAT=$O(^PRC(421.8,"AD",DAT)) Q:'DAT!(DAT>(DATE2)) D
|
||
|
|
.S DA=0 F S DA=$O(^PRC(421.8,"AD",DAT,DA)) Q:'DA I $P($G(^PRC(421.8,DA,0)),"^",8)=PRC("SITE") S DIK="^PRC(421.8," D ^DIK
|
||
|
|
D EXIT Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
DATE(Y) D DD^%DT S DATE=Y
|
||
|
|
Q DATE
|
||
|
|
;
|
||
|
|
EXIT K %,ALL,D,DA,DAT,DATE,DATE1,DATE2,DAYS,DIK,DIR,DIRUT,DTOUT,DUOUT,FTYPE,SITE,X1,X2 Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
;
|
||
|
|
QD ;Called from option PRCFA STACK DOCUMENTS PURGE (queued as background job)
|
||
|
|
;DAYS to retain is set in file 411 for PRINTER USE STACK DOCUMENTS
|
||
|
|
;DEFAULT DAYS IS 7
|
||
|
|
D DT^DICRW
|
||
|
|
S SITE=0 F S SITE=$O(^PRC(411,SITE)) Q:'SITE D
|
||
|
|
.S PRTDA=0 F S PRTDA=$O(^PRC(411,SITE,2,PRTDA)) Q:'PRTDA I $P($G(^(PRTDA,0)),"^")?1"F".E D
|
||
|
|
..S FTYPE=$P(^PRC(411,SITE,2,PRTDA,0),"^") Q:"FR"'[FTYPE S FTYPE=$S(FTYPE="FR":2,FTYPE="F":"13",1:""),DAYS=$P(^PRC(411,SITE,2,PRTDA,0),"^",4) D
|
||
|
|
...S X2=$S('DAYS:-7,1:-DAYS),X1=DT D C^%DTC S DATE2=(X-1)+.9999
|
||
|
|
...S DAT=0 F S DAT=$O(^PRC(421.8,"AD",DAT)) Q:'DAT!(DAT>DATE2) D
|
||
|
|
....S DA=0 F S DA=$O(^PRC(421.8,"AD",DAT,DA)) Q:'DA I FTYPE[(+$P($G(^PRC(421.8,DA,0)),"^",2)),$P($G(^(0)),"^",8)=SITE D PRG
|
||
|
|
Q
|
||
|
|
PRG S DIK="^PRC(421.8," D ^DIK Q
|