FSCLMPOD ;SLC/STAFF-NOIS List Manager Protocol Other Defaults ;1/13/98 13:01
;;1.1;NOIS;;Sep 06, 1998
;
NONSPEC(USER) ; from FSCLMPO
N DA,DIC,DR,DIE,OK,SPEC,Y K DIC
S OK=1
I '$D(^FSC("SPEC",USER,0)) D Q
.W !
.W !,"You currently have no package affiliations."
.W !,"By affiliating with a package, you will automatically receive alerts"
.W !,"whenever a call for that package is edited."
.W !,"You may affiliate with multiple packages."
.W !,"You can use User Defaults to edit, delete, or add packages."
.W !
.N DIR,X,Y K DIR
.S DIR(0)="YA0",DIR("A")="Do you want to set up package affiliations? ",DIR("B")="YES"
.S DIR("?",1)="Enter YES to set up package affiliations."
.S DIR("?",2)="Enter NO to exit."
.S DIR("?",3)="Enter '^' or '??' for more help."
.S DIR("?")="^D HELP^FSCU(.DIR)"
.S DIR("??")="FSC U1 NOIS"
.D ^DIR K DIR
.I Y'=1 Q
.D SETUP(USER,.OK) I 'OK D UNABLE
W ! S (DIC,DIE)="^FSC(""SPEC"","
S (DA,SPEC)=+DUZ D EN^DIQ
I '$O(^FSC("SPEC",USER,30,0)) W !,"You are currently not affiliated with any packages."
W ! S DR="30"
L +^FSC("SPEC",SPEC):30 I '$T D UNABLE Q
D ^DIE
L -^FSC("SPEC",SPEC)
K DIC
S VALMBCK=$S($G(FSCEXIT):"Q",1:"R")
Q
;
SETUP(USER,OK) ;
N DA,DIE,DR
L +^FSC("SPEC",0):30 I '$T S OK=0 Q
S $P(^FSC("SPEC",0),U,3)=USER,$P(^(0),U,4)=$P(^(0),U,4)+1
S ^FSC("SPEC",USER,0)=USER,^FSC("SPEC","B",USER,USER)=""
L -^FSC("SPEC",0)
S DA=USER,DIE=7105.2,DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL;30"
L +^FSC("SPEC",USER):30 I '$T S OK=0 Q
D ^DIE
L -^FSC("SPEC",USER)
Q
;
UNABLE ;
W !,"Unable to edit.",$C(7) H 2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPOD 1629 printed Oct 16, 2024@18:19:04 Page 2
FSCLMPOD ;SLC/STAFF-NOIS List Manager Protocol Other Defaults ;1/13/98 13:01
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
NONSPEC(USER) ; from FSCLMPO
+1 NEW DA,DIC,DR,DIE,OK,SPEC,Y
KILL DIC
+2 SET OK=1
+3 IF '$DATA(^FSC("SPEC",USER,0))
Begin DoDot:1
+4 WRITE !
+5 WRITE !,"You currently have no package affiliations."
+6 WRITE !,"By affiliating with a package, you will automatically receive alerts"
+7 WRITE !,"whenever a call for that package is edited."
+8 WRITE !,"You may affiliate with multiple packages."
+9 WRITE !,"You can use User Defaults to edit, delete, or add packages."
+10 WRITE !
+11 NEW DIR,X,Y
KILL DIR
+12 SET DIR(0)="YA0"
SET DIR("A")="Do you want to set up package affiliations? "
SET DIR("B")="YES"
+13 SET DIR("?",1)="Enter YES to set up package affiliations."
+14 SET DIR("?",2)="Enter NO to exit."
+15 SET DIR("?",3)="Enter '^' or '??' for more help."
+16 SET DIR("?")="^D HELP^FSCU(.DIR)"
+17 SET DIR("??")="FSC U1 NOIS"
+18 DO ^DIR
KILL DIR
+19 IF Y'=1
QUIT
+20 DO SETUP(USER,.OK)
IF 'OK
DO UNABLE
End DoDot:1
QUIT
+21 WRITE !
SET (DIC,DIE)="^FSC(""SPEC"","
+22 SET (DA,SPEC)=+DUZ
DO EN^DIQ
+23 IF '$ORDER(^FSC("SPEC",USER,30,0))
WRITE !,"You are currently not affiliated with any packages."
+24 WRITE !
SET DR="30"
+25 LOCK +^FSC("SPEC",SPEC):30
IF '$TEST
DO UNABLE
QUIT
+26 DO ^DIE
+27 LOCK -^FSC("SPEC",SPEC)
+28 KILL DIC
+29 SET VALMBCK=$SELECT($GET(FSCEXIT):"Q",1:"R")
+30 QUIT
+31 ;
SETUP(USER,OK) ;
+1 NEW DA,DIE,DR
+2 LOCK +^FSC("SPEC",0):30
IF '$TEST
SET OK=0
QUIT
+3 SET $PIECE(^FSC("SPEC",0),U,3)=USER
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+4 SET ^FSC("SPEC",USER,0)=USER
SET ^FSC("SPEC","B",USER,USER)=""
+5 LOCK -^FSC("SPEC",0)
+6 SET DA=USER
SET DIE=7105.2
SET DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL;30"
+7 LOCK +^FSC("SPEC",USER):30
IF '$TEST
SET OK=0
QUIT
+8 DO ^DIE
+9 LOCK -^FSC("SPEC",USER)
+10 QUIT
+11 ;
UNABLE ;
+1 WRITE !,"Unable to edit.",$CHAR(7)
HANG 2
+2 QUIT
