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
Q
;
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)
Q
;
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
Q
;
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
Q
;
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
Q
;
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)
Q
;
NOTDONE ;
W !,"No calls were purged."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCUM 1854 printed Sep 23, 2025@19:56:45 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
