PRCNPURG ;SSI/ALA-Purge transactions ;[ 03/08/96 10:15 AM ]
;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
EN ; Ask for number of days to retain transactions
K DIR S DIR("A")="Select number of days to retain equipment/turn-in requests "
S DIR("?")="Enter the number of days from today that completed and cancelled equipment/turn-in requests will be retained"
S DIR(0)="N^7:365" D ^DIR G EXIT:$D(DIRUT)
S NDYS=X
EQR ; Purge completed equipment requests
S GLO=413,DIK="^PRCN(413," D CAN
F ST=16,34 S NN="",DIK="^PRCN(413," D
. F S NN=$O(^PRCN(413,"AC",ST,NN)) Q:NN="" D
.. S X1=$P(^PRCN(413,NN,0),U,8),X2=NDYS
.. D C^%DTC Q:X'>DT S DA=NN D DK
K DA,NN,X1,X2,ST,X,DIK
TIR ; Purge completed turn-in requests
S GLO=413.1,DIK="^PRCN(413.1," D CAN
S NN="",DIK="^PRCN(413.1,"
F S NN=$O(^PRCN(413.1,"AC",24,NN)) Q:NN="" D
. S X1=$P(^PRCN(413.1,NN,0),U,8),X2=NDYS
. D C^%DTC Q:X'>DT S DA=NN D DK
EXIT K NN,DIK,DA,X1,X2,X,DIR,NDYS
Q
DK D ^DIK
Q
CAN ; Purge cancelled transactions
S NN="" F S NN=$O(^PRCN(GLO,"AC",20,NN)) Q:NN="" S DA=NN D DK
K GLO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCNPURG 1099 printed Dec 13, 2024@01:54:31 Page 2
PRCNPURG ;SSI/ALA-Purge transactions ;[ 03/08/96 10:15 AM ]
+1 ;;1.0;Equipment/Turn-In Request;;Sep 13, 1996
EN ; Ask for number of days to retain transactions
+1 KILL DIR
SET DIR("A")="Select number of days to retain equipment/turn-in requests "
+2 SET DIR("?")="Enter the number of days from today that completed and cancelled equipment/turn-in requests will be retained"
+3 SET DIR(0)="N^7:365"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
+4 SET NDYS=X
EQR ; Purge completed equipment requests
+1 SET GLO=413
SET DIK="^PRCN(413,"
DO CAN
+2 FOR ST=16,34
SET NN=""
SET DIK="^PRCN(413,"
Begin DoDot:1
+3 FOR
SET NN=$ORDER(^PRCN(413,"AC",ST,NN))
if NN=""
QUIT
Begin DoDot:2
+4 SET X1=$PIECE(^PRCN(413,NN,0),U,8)
SET X2=NDYS
+5 DO C^%DTC
if X'>DT
QUIT
SET DA=NN
DO DK
End DoDot:2
End DoDot:1
+6 KILL DA,NN,X1,X2,ST,X,DIK
TIR ; Purge completed turn-in requests
+1 SET GLO=413.1
SET DIK="^PRCN(413.1,"
DO CAN
+2 SET NN=""
SET DIK="^PRCN(413.1,"
+3 FOR
SET NN=$ORDER(^PRCN(413.1,"AC",24,NN))
if NN=""
QUIT
Begin DoDot:1
+4 SET X1=$PIECE(^PRCN(413.1,NN,0),U,8)
SET X2=NDYS
+5 DO C^%DTC
if X'>DT
QUIT
SET DA=NN
DO DK
End DoDot:1
EXIT KILL NN,DIK,DA,X1,X2,X,DIR,NDYS
+1 QUIT
DK DO ^DIK
+1 QUIT
CAN ; Purge cancelled transactions
+1 SET NN=""
FOR
SET NN=$ORDER(^PRCN(GLO,"AC",20,NN))
if NN=""
QUIT
SET DA=NN
DO DK
+2 KILL GLO
+3 QUIT
