source: WorldVistAEHR/trunk/r/EQUIPMENT_TURN_IN_REQUEST-PRCN/PRCNPURG.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1PRCNPURG ;SSI/ALA-Purge transactions ;[ 03/08/96 10:15 AM ]
2 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
3EN ; 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
8EQR ; 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
15TIR ; 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
21EXIT K NN,DIK,DA,X1,X2,X,DIR,NDYS
22 Q
23DK D ^DIK
24 Q
25CAN ; 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
Note: See TracBrowser for help on using the repository browser.