1 | PRCNPURG ;SSI/ALA-Purge transactions ;[ 03/08/96 10:15 AM ]
|
---|
2 | ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
|
---|
3 | EN ; Ask for number of days to retain transactions
|
---|
4 | K DIR S DIR("A")="Select number of days to retain equipment/turn-in requests "
|
---|
5 | S DIR("?")="Enter the number of days from today that completed and cancelled equipment/turn-in requests will be retained"
|
---|
6 | S DIR(0)="N^7:365" D ^DIR G EXIT:$D(DIRUT)
|
---|
7 | S NDYS=X
|
---|
8 | EQR ; Purge completed equipment requests
|
---|
9 | S GLO=413,DIK="^PRCN(413," D CAN
|
---|
10 | F ST=16,34 S NN="",DIK="^PRCN(413," D
|
---|
11 | . F S NN=$O(^PRCN(413,"AC",ST,NN)) Q:NN="" D
|
---|
12 | .. S X1=$P(^PRCN(413,NN,0),U,8),X2=NDYS
|
---|
13 | .. D C^%DTC Q:X'>DT S DA=NN D DK
|
---|
14 | K DA,NN,X1,X2,ST,X,DIK
|
---|
15 | TIR ; Purge completed turn-in requests
|
---|
16 | S GLO=413.1,DIK="^PRCN(413.1," D CAN
|
---|
17 | S NN="",DIK="^PRCN(413.1,"
|
---|
18 | F S NN=$O(^PRCN(413.1,"AC",24,NN)) Q:NN="" D
|
---|
19 | . S X1=$P(^PRCN(413.1,NN,0),U,8),X2=NDYS
|
---|
20 | . D C^%DTC Q:X'>DT S DA=NN D DK
|
---|
21 | EXIT K NN,DIK,DA,X1,X2,X,DIR,NDYS
|
---|
22 | Q
|
---|
23 | DK D ^DIK
|
---|
24 | Q
|
---|
25 | CAN ; Purge cancelled transactions
|
---|
26 | S NN="" F S NN=$O(^PRCN(GLO,"AC",20,NN)) Q:NN="" S DA=NN D DK
|
---|
27 | K GLO
|
---|
28 | Q
|
---|