- 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 Feb 18, 2025@23:44:27 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