XDRDPRG2 ;SF-IRMFO/REM - PURGE MERGE PROCESS FILE; 9/26/96
;;7.3;TOOLKIT;**23**;Apr 25, 1995
;;
;;
EN ;
N Y
Q:$$CHK(15.2)
;W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to Queue this purging (Y/N)"
;D ^DIR K DIR I $D(DIRUT) Q
;I Y D QUEUE Q
D ASK
Q
;
QUEUE ;Queues the process.
S ZTRTN="START^XDRDPRG2",ZTIO="",ZTDESC="Merge Process File Purge"
D ^%ZTLOAD
QUEUEX Q
;
CHK(XDRFL) ;Checks if data in file.
N XDRGL
S XDRGL=^DIC(XDRFL,0,"GL")
I $D(@(XDRGL_"""B"""_")")) Q 0
W *7,!!,"THERE IS NO DATA IN FILE!",!!
Q 1
;
ASK ;Ask user for entries to purge then purge.
N Y,DA,DIC,DIR,DIK,NAME
F D Q:Y<0
.W ! S DIC=15.2,DIC(0)="AEMZ",DIC("A")="Select Merge Process to Purge: "
.S DIC("S")="I $P(^(0),U,4)=""C""" ;Scrn for only Completed ones.
.D ^DIC Q:+Y<0 S NAME=Y(0,0),DA=+Y
.S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to delete """_NAME_""""
.D ^DIR Q:$D(DIRUT)!('Y)
.S DIK="^VA(15.2," D ^DIK
.W !!,*7,?3,""""_NAME_""""," DELETED!",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDPRG2 1016 printed Nov 22, 2024@17:49:07 Page 2
XDRDPRG2 ;SF-IRMFO/REM - PURGE MERGE PROCESS FILE; 9/26/96
+1 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
+2 ;;
+3 ;;
EN ;
+1 NEW Y
+2 if $$CHK(15.2)
QUIT
+3 ;W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to Queue this purging (Y/N)"
+4 ;D ^DIR K DIR I $D(DIRUT) Q
+5 ;I Y D QUEUE Q
+6 DO ASK
+7 QUIT
+8 ;
QUEUE ;Queues the process.
+1 SET ZTRTN="START^XDRDPRG2"
SET ZTIO=""
SET ZTDESC="Merge Process File Purge"
+2 DO ^%ZTLOAD
QUEUEX QUIT
+1 ;
CHK(XDRFL) ;Checks if data in file.
+1 NEW XDRGL
+2 SET XDRGL=^DIC(XDRFL,0,"GL")
+3 IF $DATA(@(XDRGL_"""B"""_")"))
QUIT 0
+4 WRITE *7,!!,"THERE IS NO DATA IN FILE!",!!
+5 QUIT 1
+6 ;
ASK ;Ask user for entries to purge then purge.
+1 NEW Y,DA,DIC,DIR,DIK,NAME
+2 FOR
Begin DoDot:1
+3 WRITE !
SET DIC=15.2
SET DIC(0)="AEMZ"
SET DIC("A")="Select Merge Process to Purge: "
+4 ;Scrn for only Completed ones.
SET DIC("S")="I $P(^(0),U,4)=""C"""
+5 DO ^DIC
if +Y<0
QUIT
SET NAME=Y(0,0)
SET DA=+Y
+6 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to delete """_NAME_""""
+7 DO ^DIR
if $DATA(DIRUT)!('Y)
QUIT
+8 SET DIK="^VA(15.2,"
DO ^DIK
+9 WRITE !!,*7,?3,""""_NAME_""""," DELETED!",!
End DoDot:1
if Y<0
QUIT
+10 QUIT
