source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCUM.m@ 1076

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1FSCUM ;SLC/STAFF-NOIS Utilities Maintenance ;9/27/96 17:26
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4DELETE ; from programmer
5 N CALL,CALLNAME,DIC,X,Y K DIC
6 S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select NOIS call to be deleted: "
7 D ^DIC Q:Y<1
8 K DIC
9 S CALL=+Y,CALLNAME=$P(Y,U,2)
10 N DIR,X,Y
11 W !!,CALL,!,CALLNAME
12 Q
13 ;
14PURGE ;
15 K ^TMP("FSC PURGE",$J)
16 N LIST,NUM,OK
17 D WARNING(.OK)
18 I 'OK D NOTDONE Q
19 D LIST(.LIST,.NUM,.OK)
20 I 'OK D NOTDONE Q
21 I 'NUM W !,"No calls on this list.",! Q
22 W !,NUM," calls will be deleted."
23 D ASK(.OK)
24 I 'OK D NOTDONE Q
25 D WIPEOUT
26 K ^TMP("FSC PURGE",$J)
27 Q
28 ;
29WARNING(OK) ;
30 N DIR,X,Y K DIR
31 S OK=0
32 W !,"WARNING!!!! This option is used to PURGE calls.",$C(7),!
33 S DIR(0)="YA0",DIR("A")="Are you sure you want to do this? ",DIR("B")="NO"
34 S DIR("?",1)="Enter YES to get a list to purge."
35 S DIR("?",2)="Enter or '^' to exit."
36 S DIR("?")="^D HELP^FSCU(.DIR)"
37 S DIR("??")="FSC U1 NOIS"
38 D ^DIR K DIR
39 I Y=1 S OK=1
40 Q
41 ;
42LIST(LIST,NUM,OK) ;
43 S LIST="",(NUM,OK)=0
44 N CALL,LIMIT
45 D LIST^FSCULOOK(.LIST,.LIMIT,.OK)
46 I 'OK Q
47 S LIST=+LIST
48 S CALL=0 F S CALL=$O(^FSCD("LISTS","ALC",LIST,CALL)) Q:CALL<1 D
49 .S ^TMP("FSC PURGE",$J,CALL)=""
50 .S NUM=NUM+1
51 Q
52 ;
53ASK(OK) ;
54 N DIR,X,Y K DIR
55 S OK=0
56 W !,"WARNING!!!! This will purge the calls in this list.",$C(7),!
57 S DIR(0)="YA0",DIR("A")="Are you sure you want to do this? ",DIR("B")="NO"
58 S DIR("?",1)="Enter YES to purge these calls."
59 S DIR("?",2)="Enter or '^' to exit."
60 S DIR("?")="^D HELP^FSCU(.DIR)"
61 S DIR("??")="FSC U1 NOIS"
62 D ^DIR K DIR
63 I Y=1 S OK=1
64 Q
65 ;
66WIPEOUT ;
67 N CALL
68 S CALL=0 F S CALL=$O(^TMP("FSC PURGE",$J,CALL)) Q:CALL<1 D
69 .W !,$P($G(^FSCD("CALL",CALL,0)),U)
70 .Q ; ****
71 .M ^FSCD("ZZPURGE",CALL)=^FSCD("CALL",CALL)
72 .D DELETE^FSCUCD(CALL)
73 Q
74 ;
75NOTDONE ;
76 W !,"No calls were purged."
77 Q
Note: See TracBrowser for help on using the repository browser.