source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRDPRG2.m@ 1608

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

initial load of WorldVistAEHR

File size: 980 bytes
Line 
1XDRDPRG2 ;SF-IRMFO/REM - PURGE MERGE PROCESS FILE; 9/26/96
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4 ;;
5EN ;
6 N Y
7 Q:$$CHK(15.2)
8 ;W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to Queue this purging (Y/N)"
9 ;D ^DIR K DIR I $D(DIRUT) Q
10 ;I Y D QUEUE Q
11 D ASK
12 Q
13 ;
14QUEUE ;Queues the process.
15 S ZTRTN="START^XDRDPRG2",ZTIO="",ZTDESC="Merge Process File Purge"
16 D ^%ZTLOAD
17QUEUEX Q
18 ;
19CHK(XDRFL) ;Checks if data in file.
20 N XDRGL
21 S XDRGL=^DIC(XDRFL,0,"GL")
22 I $D(@(XDRGL_"""B"""_")")) Q 0
23 W *7,!!,"THERE IS NO DATA IN FILE!",!!
24 Q 1
25 ;
26ASK ;Ask user for entries to purge then purge.
27 N Y,DA,DIC,DIR,DIK,NAME
28 F D Q:Y<0
29 .W ! S DIC=15.2,DIC(0)="AEMZ",DIC("A")="Select Merge Process to Purge: "
30 .S DIC("S")="I $P(^(0),U,4)=""C""" ;Scrn for only Completed ones.
31 .D ^DIC Q:+Y<0 S NAME=Y(0,0),DA=+Y
32 .S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to delete """_NAME_""""
33 .D ^DIR Q:$D(DIRUT)!('Y)
34 .S DIK="^VA(15.2," D ^DIK
35 .W !!,*7,?3,""""_NAME_""""," DELETED!",!
36 Q
Note: See TracBrowser for help on using the repository browser.