| 1 | PRCFACPR ;WISC@ALTOONA/CTB-PURGE CODE SHEETS SYSTEM ;11-27-92/08:17
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S PRCFASYS="FEE^FEN^RR^IRS^CLI^ISM^PRC"
|
|---|
| 5 | EN I $D(ZTQUEUED) G SCHEDULE
|
|---|
| 6 | A S U="^" F I=1:1 Q:$P($T(A+I),";",3)="" W !,$P($T(A+I),";",3,99)
|
|---|
| 7 | ;;This routine will delete LOG Code Sheets from the Code Sheet file
|
|---|
| 8 | ;;and Batch and Transmission records from the LOG Transmission Record File.
|
|---|
| 9 | ;;It will delete all reference to these code sheets, batches and transmission
|
|---|
| 10 | ;;records, except references maintained in the Code Sheet History section of
|
|---|
| 11 | ;;the Purchase Order file. Deletion is base on the transmission date of
|
|---|
| 12 | ;;the code sheet and date created for batch and transmission records.
|
|---|
| 13 | ;;
|
|---|
| 14 | S PRCF("X")="AS" D ^PRCFSITE G:'% OUT G B
|
|---|
| 15 | A1 W !!,"Enter an integer greater than 0, the system will compute the date",!,"prior to which all code sheets will be deleted for the station selected." G B
|
|---|
| 16 | B W !!,"Enter the number of days you wish to retain LOG Code Sheets: " R X:$S($D(DTIME):DTIME,1:300) G:X=""!(X="^") OUT G:X<1 A1
|
|---|
| 17 | S X2=-(X) D NOW^PRCFQ S X1=X D C^%DTC S Y1=Y,(Y,PRCFA("KDATE"))=X D D^PRCFQ S PRCFA("DATE")=Y
|
|---|
| 18 | W ! S %A="I will now delete all LOG code sheets and associated records which were"
|
|---|
| 19 | S %A(1)="transmitted on or before "_Y_" for station "_PRC("SITE")_".",%A(2)="OK to continue",%B="" S %=1 D ^PRCFYN G:%'=1 OUT
|
|---|
| 20 | W $C(7) S %A="ARE YOU SURE",%B="With a response of 'YES', I will begin deleting the code sheets and transmission records NOW." S %=2 D ^PRCFYN G:%'=1 OUT
|
|---|
| 21 | D NOW^PRCFQ S PRCFA("QTIME")=%X
|
|---|
| 22 | S PRCFQ("FORCEQ")="",PRCFA("QION")=ION,ZTSAVE("PRCFASYS")="",ZTDESC="PURGE CODE SHEET AND TRANSMISSION RECORDS",ZTRTN="DQ^PRCFACPS",ZTSAVE("PRCFA*")="",ZTSAVE("PRC*")="" D ^PRCFQ
|
|---|
| 23 | OUT K %,%DT,%H,%I,D,DA,DIC,DIK,I,J,JX,K,PRCFA,TRANS,X,Y,Y1,Z,ZERO Q
|
|---|
| 24 | SCHEDULE ;ENTRY POINT AS SCHEDULED OPTION
|
|---|
| 25 | S PRCFA("QTIME")="Recurring",PRCFA("QION")="N/A"
|
|---|
| 26 | S PRC("SITE")=0 F I=1:1 S PRC("SITE")=$O(^PRC(411,PRC("SITE"))) Q:'PRC("SITE") I $D(^(PRC("SITE"),0)) S X=$P(^(0),"^",14) I X D C,DQ^PRCFACPS
|
|---|
| 27 | Q
|
|---|
| 28 | C S X2=-(X) D NOW^PRCFQ S X1=X D C^%DTC S Y1=Y,(Y,PRCFA("KDATE"))=X D D^PRCFQ S PRCFA("DATE")=Y Q
|
|---|
