| 1 | PRCPXALL ;WISC/RFJ-purge all automatically by TaskManager ; 2/19/07 1:19pm
|
|---|
| 2 | ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DQ ; TaskManager comes here to start the automatic purge of
|
|---|
| 8 | ; inventory points.
|
|---|
| 9 | N %,%H,%I,INVPT,NOWDT,PRCP,PRCPZTSK,STOPDATE,TYPE,X,Y
|
|---|
| 10 | D NOW^%DTC S NOWDT=$E(X,1,5)_"01",X1=$E(X,1,5)_"15",X2=-395 D C^%DTC S (Y,STOPDATE)=$E(X,1,5)_"01"
|
|---|
| 11 | S PRCPZTSK=1
|
|---|
| 12 | S INVPT=0 F S INVPT=$O(^PRCP(445,INVPT)) Q:'INVPT I $P($G(^(INVPT,0)),"^",21)="Y" S TYPE=$P(^(0),"^",3) I TYPE'="" D
|
|---|
| 13 | . S PRCP("I")=INVPT
|
|---|
| 14 | . ; distribution history (file 446)
|
|---|
| 15 | . I TYPE'="S" D DQ^PRCPXDIS
|
|---|
| 16 | . ; receipts
|
|---|
| 17 | . D DQ^PRCPXREC
|
|---|
| 18 | . ; transaction register
|
|---|
| 19 | . D DQ^PRCPXTRA
|
|---|
| 20 | . ; usage/distribution totals
|
|---|
| 21 | . D DQ^PRCPXUSE
|
|---|
| 22 | . ; on-demand item audits (PRC*5.1*98)
|
|---|
| 23 | . I TYPE'="W" D DQ^PRCPXODI
|
|---|
| 24 | Q
|
|---|
