1 | FSCLMPOD ;SLC/STAFF-NOIS List Manager Protocol Other Defaults ;1/13/98 13:01
|
---|
2 | ;;1.1;NOIS;;Sep 06, 1998
|
---|
3 | ;
|
---|
4 | NONSPEC(USER) ; from FSCLMPO
|
---|
5 | N DA,DIC,DR,DIE,OK,SPEC,Y K DIC
|
---|
6 | S OK=1
|
---|
7 | I '$D(^FSC("SPEC",USER,0)) D Q
|
---|
8 | .W !
|
---|
9 | .W !,"You currently have no package affiliations."
|
---|
10 | .W !,"By affiliating with a package, you will automatically receive alerts"
|
---|
11 | .W !,"whenever a call for that package is edited."
|
---|
12 | .W !,"You may affiliate with multiple packages."
|
---|
13 | .W !,"You can use User Defaults to edit, delete, or add packages."
|
---|
14 | .W !
|
---|
15 | .N DIR,X,Y K DIR
|
---|
16 | .S DIR(0)="YA0",DIR("A")="Do you want to set up package affiliations? ",DIR("B")="YES"
|
---|
17 | .S DIR("?",1)="Enter YES to set up package affiliations."
|
---|
18 | .S DIR("?",2)="Enter NO to exit."
|
---|
19 | .S DIR("?",3)="Enter '^' or '??' for more help."
|
---|
20 | .S DIR("?")="^D HELP^FSCU(.DIR)"
|
---|
21 | .S DIR("??")="FSC U1 NOIS"
|
---|
22 | .D ^DIR K DIR
|
---|
23 | .I Y'=1 Q
|
---|
24 | .D SETUP(USER,.OK) I 'OK D UNABLE
|
---|
25 | W ! S (DIC,DIE)="^FSC(""SPEC"","
|
---|
26 | S (DA,SPEC)=+DUZ D EN^DIQ
|
---|
27 | I '$O(^FSC("SPEC",USER,30,0)) W !,"You are currently not affiliated with any packages."
|
---|
28 | W ! S DR="30"
|
---|
29 | L +^FSC("SPEC",SPEC):30 I '$T D UNABLE Q
|
---|
30 | D ^DIE
|
---|
31 | L -^FSC("SPEC",SPEC)
|
---|
32 | K DIC
|
---|
33 | S VALMBCK=$S($G(FSCEXIT):"Q",1:"R")
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | SETUP(USER,OK) ;
|
---|
37 | N DA,DIE,DR
|
---|
38 | L +^FSC("SPEC",0):30 I '$T S OK=0 Q
|
---|
39 | S $P(^FSC("SPEC",0),U,3)=USER,$P(^(0),U,4)=$P(^(0),U,4)+1
|
---|
40 | S ^FSC("SPEC",USER,0)=USER,^FSC("SPEC","B",USER,USER)=""
|
---|
41 | L -^FSC("SPEC",0)
|
---|
42 | S DA=USER,DIE=7105.2,DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL;30"
|
---|
43 | L +^FSC("SPEC",USER):30 I '$T S OK=0 Q
|
---|
44 | D ^DIE
|
---|
45 | L -^FSC("SPEC",USER)
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | UNABLE ;
|
---|
49 | W !,"Unable to edit.",$C(7) H 2
|
---|
50 | Q
|
---|