XDRDPRG2.m

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 ---XDRDPRG2   1016     printed  Apr 09, 2024@21:44:10                                                                                                                                                                                                    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