FSCLDR ;SLC/STAFF-NOIS List Definition Replace ;9/6/98 20:49
;;1.1;NOIS;;Sep 06, 1998
;
RALL ; from FSCLMP
I '$$CHECK^FSCLMPM(FSCLNUM,DUZ) W !,"You cannot edit this list.",$C(7) H 2 Q
N LISTNAME,LISTNUM,LISTTYPE,NAME,NOTFLAG,OK,OWNER,ZERO
S LISTNAME=FSCLNAME,LISTNUM=FSCLNUM
S ZERO=^FSC("LIST",LISTNUM,0)
S LISTTYPE=$P(ZERO,U,3) I '$L(LISTTYPE) S LISTTYPE="S"
I "AMS"'[LISTTYPE W !,"You cannot edit this list.",$C(7) H 2 Q
D NAME^FSCMU(LISTNAME,.NAME,.OK) I 'OK Q
I NAME="@" D DELETE(LISTNAME,LISTNUM) Q
D OWNER^FSCMU(+$P(ZERO,U,2),.OWNER,.OK) I 'OK Q
D
.N DIR,X,Y K DIR
.I LISTTYPE="A" D Q
..S DIR(0)="YAO",DIR("A")="Change type from Active to Manual update? ",DIR("B")="NO"
..S DIR("?",1)="Enter YES to change the list type."
..S DIR("?",2)="Enter NO or '^' to not change the type."
..S DIR("?")="^D HELP^FSCU(.DIR)"
..S DIR("??")="FSC U 1 NOIS"
..D ^DIR K DIR
..I Y=1 S LISTTYPE="M" D DELCALLS(LISTNUM)
.I LISTTYPE="M" D Q
..S DIR(0)="YAO",DIR("A")="Change type from Manual to Active update? ",DIR("B")="NO"
..S DIR("?",1)="Enter YES to change the list type."
..S DIR("?",2)="Enter NO or '^' to not change the type."
..S DIR("?")="^D HELP^FSCU(.DIR)"
..S DIR("??")="FSC U 1 NOIS"
..D ^DIR K DIR
..I Y=1 S FSCQEDIT=1,LISTTYPE="A"
S NOTFLAG=$S($L($P(ZERO,U,6))&$L($P(ZERO,U,7)):1,1:0)
N DA,DIE,DR S DIE="^FSC(""LIST"",",DA=LISTNUM,DR=".01///"_NAME_$S($L(OWNER):";1///"_OWNER,1:"")_";2///"_LISTTYPE_$S(LISTTYPE="A":";5;6;7",1:";5///@;6///@;7///@")_";200"
L +^FSC("LIST",LISTNUM):30 I '$T D UNABLE Q
D ^DIE
L -^FSC("LIST",LISTNUM)
I NOTFLAG,'$L($P(^FSC("LIST",LISTNUM,0),U,6))!'$L($P(^(0),U,7)) D DELNOT(LISTNUM)
I $D(VALMAR) D ENTRY^FSCLMM,HEADER^FSCLMM
S FSCLNAME=NAME,FSCLNUM=LISTNUM
Q
;
DELETE(LISTNAME,LISTNUM) ; from FSCLMPM
N DA,DIE,DIK,DR,SPEC
D DELCALLS(LISTNUM)
S DIE=7105.2,DR="9///@"
S SPEC=0 F S SPEC=$O(^FSC("SPEC","AL",LISTNUM,SPEC)) Q:SPEC<1 D
.S DA=SPEC
.L +^FSC("SPEC",SPEC):30 I '$T D UNABLE Q
.D ^DIE
.L -^FSC("SPEC",SPEC)
.W !,"Deleted default list of ",$$VALUE^FSCGET(SPEC,7105.2,.01)
D DELNOT(LISTNUM)
D DELMRU(LISTNUM)
S DA=LISTNUM,DIK="^FSC(""LIST""," D ^DIK
W !,LISTNAME," deleted." H 2
S VALMBCK="Q",FSCEXIT=1 ; exit from list manager after deleting a list
Q
;
DELCALLS(LISTNUM) ;
N CALL,LISTSNUM
W ! S CALL=0 F S CALL=$O(^FSCD("LISTS","ALC",LISTNUM,CALL)) Q:CALL<1 S LISTSNUM=+$O(^(CALL,0)) I LISTSNUM D DELETE^FSCLMPS(LISTSNUM) W "."
Q
;
DELNOT(LISTNUM) ;
N DA,DIK,NOTIFY
W !,"Deleting notifications for this list."
S DIK="^FSCD(""NOTIFY"","
S NOTIFY=0 F S NOTIFY=$O(^FSCD("NOTIFY","ALIST",LISTNUM,NOTIFY)) Q:NOTIFY<1 D
.W "." S DA=NOTIFY
.L +^FSCD("NOTIFY",NOTIFY):30 I '$T D UNABLE Q
.D ^DIK
.L -^FSCD("NOTIFY",NOTIFY)
Q
;
DELMRU(LISTNUM) ; from FSCRPCLO
N NUM
S NUM=0 F S NUM=$O(^FSCD("MRU","AL",LISTNUM,NUM)) Q:NUM<1 D DEL^FSCUCD("^FSCD(""MRU"",",NUM)
Q
;
REPLACE(LISTNAME,LISTNUM) ; from FSCLMPE, FSCLMPM
; not scoped
W !,"Reenter a query definition for ",LISTNAME,!
D ADD^FSCLMPM(0,"ADD")
Q
;
UNABLE ;
W !,"Unable to edit."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLDR 3139 printed Sep 23, 2025@19:54:17 Page 2
FSCLDR ;SLC/STAFF-NOIS List Definition Replace ;9/6/98 20:49
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
RALL ; from FSCLMP
+1 IF '$$CHECK^FSCLMPM(FSCLNUM,DUZ)
WRITE !,"You cannot edit this list.",$CHAR(7)
HANG 2
QUIT
+2 NEW LISTNAME,LISTNUM,LISTTYPE,NAME,NOTFLAG,OK,OWNER,ZERO
+3 SET LISTNAME=FSCLNAME
SET LISTNUM=FSCLNUM
+4 SET ZERO=^FSC("LIST",LISTNUM,0)
+5 SET LISTTYPE=$PIECE(ZERO,U,3)
IF '$LENGTH(LISTTYPE)
SET LISTTYPE="S"
+6 IF "AMS"'[LISTTYPE
WRITE !,"You cannot edit this list.",$CHAR(7)
HANG 2
QUIT
+7 DO NAME^FSCMU(LISTNAME,.NAME,.OK)
IF 'OK
QUIT
+8 IF NAME="@"
DO DELETE(LISTNAME,LISTNUM)
QUIT
+9 DO OWNER^FSCMU(+$PIECE(ZERO,U,2),.OWNER,.OK)
IF 'OK
QUIT
+10 Begin DoDot:1
+11 NEW DIR,X,Y
KILL DIR
+12 IF LISTTYPE="A"
Begin DoDot:2
+13 SET DIR(0)="YAO"
SET DIR("A")="Change type from Active to Manual update? "
SET DIR("B")="NO"
+14 SET DIR("?",1)="Enter YES to change the list type."
+15 SET DIR("?",2)="Enter NO or '^' to not change the type."
+16 SET DIR("?")="^D HELP^FSCU(.DIR)"
+17 SET DIR("??")="FSC U 1 NOIS"
+18 DO ^DIR
KILL DIR
+19 IF Y=1
SET LISTTYPE="M"
DO DELCALLS(LISTNUM)
End DoDot:2
QUIT
+20 IF LISTTYPE="M"
Begin DoDot:2
+21 SET DIR(0)="YAO"
SET DIR("A")="Change type from Manual to Active update? "
SET DIR("B")="NO"
+22 SET DIR("?",1)="Enter YES to change the list type."
+23 SET DIR("?",2)="Enter NO or '^' to not change the type."
+24 SET DIR("?")="^D HELP^FSCU(.DIR)"
+25 SET DIR("??")="FSC U 1 NOIS"
+26 DO ^DIR
KILL DIR
+27 IF Y=1
SET FSCQEDIT=1
SET LISTTYPE="A"
End DoDot:2
QUIT
End DoDot:1
+28 SET NOTFLAG=$SELECT($LENGTH($PIECE(ZERO,U,6))&$LENGTH($PIECE(ZERO,U,7)):1,1:0)
+29 NEW DA,DIE,DR
SET DIE="^FSC(""LIST"","
SET DA=LISTNUM
SET DR=".01///"_NAME_$SELECT($LENGTH(OWNER):";1///"_OWNER,1:"")_";2///"_LISTTYPE_$SELECT(LISTTYPE="A":";5;6;7",1:";5///@;6///@;7///@")_";200"
+30 LOCK +^FSC("LIST",LISTNUM):30
IF '$TEST
DO UNABLE
QUIT
+31 DO ^DIE
+32 LOCK -^FSC("LIST",LISTNUM)
+33 IF NOTFLAG
IF '$LENGTH($PIECE(^FSC("LIST",LISTNUM,0),U,6))!'$LENGTH($PIECE(^(0),U,7))
DO DELNOT(LISTNUM)
+34 IF $DATA(VALMAR)
DO ENTRY^FSCLMM
DO HEADER^FSCLMM
+35 SET FSCLNAME=NAME
SET FSCLNUM=LISTNUM
+36 QUIT
+37 ;
DELETE(LISTNAME,LISTNUM) ; from FSCLMPM
+1 NEW DA,DIE,DIK,DR,SPEC
+2 DO DELCALLS(LISTNUM)
+3 SET DIE=7105.2
SET DR="9///@"
+4 SET SPEC=0
FOR
SET SPEC=$ORDER(^FSC("SPEC","AL",LISTNUM,SPEC))
if SPEC<1
QUIT
Begin DoDot:1
+5 SET DA=SPEC
+6 LOCK +^FSC("SPEC",SPEC):30
IF '$TEST
DO UNABLE
QUIT
+7 DO ^DIE
+8 LOCK -^FSC("SPEC",SPEC)
+9 WRITE !,"Deleted default list of ",$$VALUE^FSCGET(SPEC,7105.2,.01)
End DoDot:1
+10 DO DELNOT(LISTNUM)
+11 DO DELMRU(LISTNUM)
+12 SET DA=LISTNUM
SET DIK="^FSC(""LIST"","
DO ^DIK
+13 WRITE !,LISTNAME," deleted."
HANG 2
+14 ; exit from list manager after deleting a list
SET VALMBCK="Q"
SET FSCEXIT=1
+15 QUIT
+16 ;
DELCALLS(LISTNUM) ;
+1 NEW CALL,LISTSNUM
+2 WRITE !
SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("LISTS","ALC",LISTNUM,CALL))
if CALL<1
QUIT
SET LISTSNUM=+$ORDER(^(CALL,0))
IF LISTSNUM
DO DELETE^FSCLMPS(LISTSNUM)
WRITE "."
+3 QUIT
+4 ;
DELNOT(LISTNUM) ;
+1 NEW DA,DIK,NOTIFY
+2 WRITE !,"Deleting notifications for this list."
+3 SET DIK="^FSCD(""NOTIFY"","
+4 SET NOTIFY=0
FOR
SET NOTIFY=$ORDER(^FSCD("NOTIFY","ALIST",LISTNUM,NOTIFY))
if NOTIFY<1
QUIT
Begin DoDot:1
+5 WRITE "."
SET DA=NOTIFY
+6 LOCK +^FSCD("NOTIFY",NOTIFY):30
IF '$TEST
DO UNABLE
QUIT
+7 DO ^DIK
+8 LOCK -^FSCD("NOTIFY",NOTIFY)
End DoDot:1
+9 QUIT
+10 ;
DELMRU(LISTNUM) ; from FSCRPCLO
+1 NEW NUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("MRU","AL",LISTNUM,NUM))
if NUM<1
QUIT
DO DEL^FSCUCD("^FSCD(""MRU"",",NUM)
+3 QUIT
+4 ;
REPLACE(LISTNAME,LISTNUM) ; from FSCLMPE, FSCLMPM
+1 ; not scoped
+2 WRITE !,"Reenter a query definition for ",LISTNAME,!
+3 DO ADD^FSCLMPM(0,"ADD")
+4 QUIT
+5 ;
UNABLE ;
+1 WRITE !,"Unable to edit."
+2 QUIT
