Routine: FSCUM

FSCUM ;SLC/STAFF-NOIS Utilities Maintenance ;9/27/96  17:26

 ;;1.1;NOIS;;Sep 06, 1998

DELETE ; from programmer

 N CALL,CALLNAME,DIC,X,Y K DIC

 S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select NOIS call to be deleted: "

 D ^DIC Q:Y<1

 K DIC

 S CALL=+Y,CALLNAME=$P(Y,U,2)

 N DIR,X,Y

 W !!,CALL,!,CALLNAME

PURGE ;

 K ^TMP("FSC PURGE",$J)

 N LIST,NUM,OK

 D WARNING(.OK)

 I 'OK D NOTDONE Q

 D LIST(.LIST,.NUM,.OK)

 I 'OK D NOTDONE Q

 I 'NUM W !,"No calls on this list.",! Q

 W !,NUM," calls will be deleted."

 D ASK(.OK)

 I 'OK D NOTDONE Q

 D WIPEOUT

 K ^TMP("FSC PURGE",$J)

WARNING(OK) ;

 N DIR,X,Y K DIR

 S OK=0

 W !,"WARNING!!!! This option is used to PURGE calls.",$C(7),!

 S DIR(0)="YA0",DIR("A")="Are you sure you want to do this? ",DIR("B")="NO"

 S DIR("?",1)="Enter YES to get a list to purge."

 S DIR("?",2)="Enter or '^' to exit."

 S DIR("?")="^D HELP^FSCU(.DIR)"

 S DIR("??")="FSC U1 NOIS"

 D ^DIR K DIR

 I Y=1 S OK=1

LIST(LIST,NUM,OK) ;

 S LIST="",(NUM,OK)=0

 N CALL,LIMIT

 D LIST^FSCULOOK(.LIST,.LIMIT,.OK)

 I 'OK Q

 S LIST=+LIST

 S CALL=0 F  S CALL=$O(^FSCD("LISTS","ALC",LIST,CALL)) Q:CALL<1  D

 .S ^TMP("FSC PURGE",$J,CALL)=""

 .S NUM=NUM+1

ASK(OK) ;

 N DIR,X,Y K DIR

 S OK=0

 W !,"WARNING!!!! This will purge the calls in this list.",$C(7),!

 S DIR(0)="YA0",DIR("A")="Are you sure you want to do this? ",DIR("B")="NO"

 S DIR("?",1)="Enter YES to purge these calls."

 S DIR("?",2)="Enter or '^' to exit."

 S DIR("?")="^D HELP^FSCU(.DIR)"

 S DIR("??")="FSC U1 NOIS"

 D ^DIR K DIR

 I Y=1 S OK=1

WIPEOUT ;

 N CALL

 S CALL=0 F  S CALL=$O(^TMP("FSC PURGE",$J,CALL)) Q:CALL<1  D

 .W !,$P($G(^FSCD("CALL",CALL,0)),U)

 .Q  ; ****

 .M ^FSCD("ZZPURGE",CALL)=^FSCD("CALL",CALL)

 .D DELETE^FSCUCD(CALL)

NOTDONE ;

 W !,"No calls were purged."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUM   1854     printed  Mar 13, 2025@21:25:26                                                                                                                                                                                                       Page 2

FSCUM     ;SLC/STAFF-NOIS Utilities Maintenance ;9/27/96  17:26

 +1       ;;1.1;NOIS;;Sep 06, 1998

 +2       ;

DELETE    ; from programmer

 +1        NEW CALL,CALLNAME,DIC,X,Y

           KILL DIC

 +2        SET DIC=7100

           SET DIC(0)="AEMOQ"

           SET DIC("A")="Select NOIS call to be deleted: "

 +3        DO ^DIC

           if Y<1

               QUIT

 +4        KILL DIC

 +5        SET CALL=+Y

           SET CALLNAME=$PIECE(Y,U,2)

 +6        NEW DIR,X,Y

 +7        WRITE !!,CALL,!,CALLNAME

 +8        QUIT

 +9       ;

PURGE     ;

 +1        KILL ^TMP("FSC PURGE",$JOB)

 +2        NEW LIST,NUM,OK

 +3        DO WARNING(.OK)

 +4        IF 'OK

               DO NOTDONE

               QUIT

 +5        DO LIST(.LIST,.NUM,.OK)

 +6        IF 'OK

               DO NOTDONE

               QUIT

 +7        IF 'NUM

               WRITE !,"No calls on this list.",!

               QUIT

 +8        WRITE !,NUM," calls will be deleted."

 +9        DO ASK(.OK)

 +10       IF 'OK

               DO NOTDONE

               QUIT

 +11       DO WIPEOUT

 +12       KILL ^TMP("FSC PURGE",$JOB)

 +13       QUIT

 +14      ;

WARNING(OK) ;

 +1        NEW DIR,X,Y

           KILL DIR

 +2        SET OK=0

 +3        WRITE !,"WARNING!!!! This option is used to PURGE calls.",$CHAR(7),!

 +4        SET DIR(0)="YA0"

           SET DIR("A")="Are you sure you want to do this? "

           SET DIR("B")="NO"

 +5        SET DIR("?",1)="Enter YES to get a list to purge."

 +6        SET DIR("?",2)="Enter or '^' to exit."

 +7        SET DIR("?")="^D HELP^FSCU(.DIR)"

 +8        SET DIR("??")="FSC U1 NOIS"

 +9        DO ^DIR

           KILL DIR

 +10       IF Y=1

               SET OK=1

 +11       QUIT

 +12      ;

LIST(LIST,NUM,OK) ;

 +1        SET LIST=""

           SET (NUM,OK)=0

 +2        NEW CALL,LIMIT

 +3        DO LIST^FSCULOOK(.LIST,.LIMIT,.OK)

 +4        IF 'OK

               QUIT

 +5        SET LIST=+LIST

 +6        SET CALL=0

FOR

               SET CALL=$ORDER(^FSCD("LISTS","ALC",LIST,CALL))

               if CALL<1

                   QUIT

               Begin DoDot:1

 +7                SET ^TMP("FSC PURGE",$JOB,CALL)=""

 +8                SET NUM=NUM+1

               End DoDot:1

 +9        QUIT

 +10      ;

ASK(OK)   ;

 +1        NEW DIR,X,Y

           KILL DIR

 +2        SET OK=0

 +3        WRITE !,"WARNING!!!! This will purge the calls in this list.",$CHAR(7),!

 +4        SET DIR(0)="YA0"

           SET DIR("A")="Are you sure you want to do this? "

           SET DIR("B")="NO"

 +5        SET DIR("?",1)="Enter YES to purge these calls."

 +6        SET DIR("?",2)="Enter or '^' to exit."

 +7        SET DIR("?")="^D HELP^FSCU(.DIR)"

 +8        SET DIR("??")="FSC U1 NOIS"

 +9        DO ^DIR

           KILL DIR

 +10       IF Y=1

               SET OK=1

 +11       QUIT

 +12      ;

WIPEOUT   ;

 +1        NEW CALL

 +2        SET CALL=0

FOR

               SET CALL=$ORDER(^TMP("FSC PURGE",$JOB,CALL))

               if CALL<1

                   QUIT

               Begin DoDot:1

 +3                WRITE !,$PIECE($GET(^FSCD("CALL",CALL,0)),U)

 +4       ; ****

                   QUIT

 +5                MERGE ^FSCD("ZZPURGE",CALL)=^FSCD("CALL",CALL)

 +6                DO DELETE^FSCUCD(CALL)

               End DoDot:1

 +7        QUIT

 +8       ;

NOTDONE   ;

 +1        WRITE !,"No calls were purged."

 +2        QUIT

FSCUM.m