FSCLMPS ;SLC/STAFF-NOIS List Manager Protocol Save and SaveAs ;9/6/98 21:09
;;1.1;NOIS;;Sep 06, 1998
;
ASLD ; from FSCLMP
I "AMS"'[$P(^FSC("LIST",FSCLNUM,0),U,3) W !,"You cannot copy this list.",$C(7) H 2 Q
N DA,DIC,DIK,DLAYGO,NAME,NEWLNUM,OK,OWNER,X,Y K DIC
D NAME^FSCMU("",.NAME,.OK) I 'OK Q
D OWNER^FSCMU(+$P($G(^FSC("LIST",FSCLNUM,0)),U,2),.OWNER,.OK) I 'OK Q
W ! D ASK^FSCLD(.OK) I 'OK Q
I '$G(OWNER) S OWNER=DUZ
S (DIC,DLAYGO)=7107.1,DIC(0)="L",X=NAME
D ^DIC I '$P(Y,U,3) K DIC W !,"Not defined.",$C(7) H 2 Q
S NEWLNUM=+Y
W !,"A copy of ",FSCLNAME," is being saved as ",NAME,".",!
M ^FSC("LIST",NEWLNUM)=^FSC("LIST",FSCLNUM)
S $P(^FSC("LIST",NEWLNUM,0),U)=NAME,$P(^(0),U,2)=OWNER
S DIK=DIC,DA=NEWLNUM D IX1^DIK K DIC
S FSCLNAME=NAME,FSCLNUM=NEWLNUM
L +^XTMP("FSC LIST DEF",FSCLNUM):20 I '$T D BAD^FSCLDS
E D BUILD^FSCLDU(FSCLNUM,.OK) I 'OK D BAD^FSCLDS
L -^XTMP("FSC LIST DEF",FSCLNUM)
D ENTRY^FSCLMM,HEADER^FSCLMM
H 1
Q
;
ASLIST ; from FSCLMP
N DEFAULT,DIC,LISTNAME,LISTNUM,NUM,X,Y K DIC,^TMP("FSC SELECT",$J,"VALUES")
S DIC=7107.1,DIC(0)="AEMOQ"
I $P($G(^FSC("LIST",FSCLNUM,0)),U,3)="S",$P(^(0),U,2)=DUZ!'$P(^(0),U,2) S DIC("B")=$P(FSCLNAME," (MODIFIED)")
I '$D(DIC("B")) S NUM=0 F S NUM=$O(^FSC("LIST","C",DUZ,NUM)) Q:NUM<1 I $P(^FSC("LIST",NUM,0),U,3)="S" S DIC("B")=$P(^(0),U) Q
I '$D(DIC("B")) D
.W !,"You do not own any STORAGE-ONLY type lists."
.W !,"You can define this type of list using the Define List action (DL)"
.W !,"for temporarily storing calls. You can still store calls under any"
.W !,"public lists."
S DIC("S")="I $P(^(0),U,3)=""S"",$P(^(0),U,2)=DUZ!'$P(^(0),U,2)"
S DIC("A")="Save to list: "
D ^DIC K DIC I Y<1 Q
S LISTNUM=+Y,LISTNAME=$P(Y,U,2),DEFAULT="1-"_+^TMP("FSC LIST CALLS",$J)
I DEFAULT="1-0" D Q
.N DIR,X,Y K DIR
.S DIR(0)="YAO",DIR("A")="Save this list with all calls removed? ",DIR("B")="YES"
.S DIR("?",1)="Enter YES to save this as an empty list."
.S DIR("?",2)="Enter NO or '^' to exit without saving."
.S DIR("?")="^D HELP^FSCU(.DIR)"
.S DIR("??")="FSC U1 NOIS"
.D ^DIR K DIR
.I Y'=1 Q
.D SAVE(LISTNUM,"REPLACE")
D SELECT^FSCUL(DEFAULT,"",DEFAULT,"VALUES",.OK) I 'OK Q
N DIR,X,Y K DIR
S DIR(0)="SAMO^ADD:ADD;REPLACE:REPLACE",DIR("A")="(A)dd calls to "_LISTNAME_" or (R)eplace "_LISTNAME_" with these calls? ",DIR("B")="ADD"
S DIR("?",1)="Enter ADD to add these calls to the list."
S DIR("?",2)="Enter REPLACE to have the list only have these calls."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
I $D(DIRUT) Q
D SAVE(LISTNUM,Y)
Q
;
SAVE(LISTNUM,SAVETYPE) ;
N CALL,CALLLINE,LISTSNUM,NUM
I SAVETYPE="REPLACE" S CALL=0 F S CALL=$O(^FSCD("LISTS","ALC",LISTNUM,CALL)) Q:CALL<1 S LISTSNUM=+$O(^(CALL,0)) I LISTSNUM D DELETE(LISTSNUM)
I SAVETYPE="ADD"!(SAVETYPE="REPLACE") D
.S NUM=0 F S NUM=$O(^TMP("FSC SELECT",$J,"VALUES",NUM)) Q:NUM<1 D
..S CALLLINE=+$O(^TMP("FSC LIST CALLS",$J,"IDX",NUM,0))
..S CALL=+$O(^TMP("FSC LIST CALLS",$J,"ICX",CALLLINE,0)) D ADD(CALL,LISTNUM)
K ^TMP("FSC SELECT",$J,"VALUES")
Q
;
ADD(CALL,LIST,OK) ; from FSCLP, FSCRPCLO, FSCRPCSL
S OK=1 I $D(^FSCD("LISTS","ALC",LIST,CALL)) S OK=0 Q
N LISTSNUM S LISTSNUM=1+$P(^FSCD("LISTS",0),U,3)
L +^FSCD("LISTS",0):30 I '$T Q ; *** skip
F Q:'$D(^FSCD("LISTS",LISTSNUM,0)) S LISTSNUM=LISTSNUM+1
S ^FSCD("LISTS",LISTSNUM,0)=CALL_U_LIST
S $P(^FSCD("LISTS",0),U,3)=LISTSNUM,$P(^(0),U,4)=$P(^(0),U,4)+1
L -^FSCD("LISTS",0)
S ^FSCD("LISTS","B",CALL,LISTSNUM)=""
S ^FSCD("LISTS","L",LIST,LISTSNUM)=""
S ^FSCD("LISTS","ALC",LIST,CALL,LISTSNUM)=""
Q
;
DELETE(DA) ; from FSCLDR, FSCLP, FSCRPCLO, FSCRPCSL
I 'DA Q
N DIK
S DIK="^FSCD(""LISTS"","
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPS 3762 printed Sep 23, 2025@19:54:53 Page 2
FSCLMPS ;SLC/STAFF-NOIS List Manager Protocol Save and SaveAs ;9/6/98 21:09
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ASLD ; from FSCLMP
+1 IF "AMS"'[$PIECE(^FSC("LIST",FSCLNUM,0),U,3)
WRITE !,"You cannot copy this list.",$CHAR(7)
HANG 2
QUIT
+2 NEW DA,DIC,DIK,DLAYGO,NAME,NEWLNUM,OK,OWNER,X,Y
KILL DIC
+3 DO NAME^FSCMU("",.NAME,.OK)
IF 'OK
QUIT
+4 DO OWNER^FSCMU(+$PIECE($GET(^FSC("LIST",FSCLNUM,0)),U,2),.OWNER,.OK)
IF 'OK
QUIT
+5 WRITE !
DO ASK^FSCLD(.OK)
IF 'OK
QUIT
+6 IF '$GET(OWNER)
SET OWNER=DUZ
+7 SET (DIC,DLAYGO)=7107.1
SET DIC(0)="L"
SET X=NAME
+8 DO ^DIC
IF '$PIECE(Y,U,3)
KILL DIC
WRITE !,"Not defined.",$CHAR(7)
HANG 2
QUIT
+9 SET NEWLNUM=+Y
+10 WRITE !,"A copy of ",FSCLNAME," is being saved as ",NAME,".",!
+11 MERGE ^FSC("LIST",NEWLNUM)=^FSC("LIST",FSCLNUM)
+12 SET $PIECE(^FSC("LIST",NEWLNUM,0),U)=NAME
SET $PIECE(^(0),U,2)=OWNER
+13 SET DIK=DIC
SET DA=NEWLNUM
DO IX1^DIK
KILL DIC
+14 SET FSCLNAME=NAME
SET FSCLNUM=NEWLNUM
+15 LOCK +^XTMP("FSC LIST DEF",FSCLNUM):20
IF '$TEST
DO BAD^FSCLDS
+16 IF '$TEST
DO BUILD^FSCLDU(FSCLNUM,.OK)
IF 'OK
DO BAD^FSCLDS
+17 LOCK -^XTMP("FSC LIST DEF",FSCLNUM)
+18 DO ENTRY^FSCLMM
DO HEADER^FSCLMM
+19 HANG 1
+20 QUIT
+21 ;
ASLIST ; from FSCLMP
+1 NEW DEFAULT,DIC,LISTNAME,LISTNUM,NUM,X,Y
KILL DIC,^TMP("FSC SELECT",$JOB,"VALUES")
+2 SET DIC=7107.1
SET DIC(0)="AEMOQ"
+3 IF $PIECE($GET(^FSC("LIST",FSCLNUM,0)),U,3)="S"
IF $PIECE(^(0),U,2)=DUZ!'$PIECE(^(0),U,2)
SET DIC("B")=$PIECE(FSCLNAME," (MODIFIED)")
+4 IF '$DATA(DIC("B"))
SET NUM=0
FOR
SET NUM=$ORDER(^FSC("LIST","C",DUZ,NUM))
if NUM<1
QUIT
IF $PIECE(^FSC("LIST",NUM,0),U,3)="S"
SET DIC("B")=$PIECE(^(0),U)
QUIT
+5 IF '$DATA(DIC("B"))
Begin DoDot:1
+6 WRITE !,"You do not own any STORAGE-ONLY type lists."
+7 WRITE !,"You can define this type of list using the Define List action (DL)"
+8 WRITE !,"for temporarily storing calls. You can still store calls under any"
+9 WRITE !,"public lists."
End DoDot:1
+10 SET DIC("S")="I $P(^(0),U,3)=""S"",$P(^(0),U,2)=DUZ!'$P(^(0),U,2)"
+11 SET DIC("A")="Save to list: "
+12 DO ^DIC
KILL DIC
IF Y<1
QUIT
+13 SET LISTNUM=+Y
SET LISTNAME=$PIECE(Y,U,2)
SET DEFAULT="1-"_+^TMP("FSC LIST CALLS",$JOB)
+14 IF DEFAULT="1-0"
Begin DoDot:1
+15 NEW DIR,X,Y
KILL DIR
+16 SET DIR(0)="YAO"
SET DIR("A")="Save this list with all calls removed? "
SET DIR("B")="YES"
+17 SET DIR("?",1)="Enter YES to save this as an empty list."
+18 SET DIR("?",2)="Enter NO or '^' to exit without saving."
+19 SET DIR("?")="^D HELP^FSCU(.DIR)"
+20 SET DIR("??")="FSC U1 NOIS"
+21 DO ^DIR
KILL DIR
+22 IF Y'=1
QUIT
+23 DO SAVE(LISTNUM,"REPLACE")
End DoDot:1
QUIT
+24 DO SELECT^FSCUL(DEFAULT,"",DEFAULT,"VALUES",.OK)
IF 'OK
QUIT
+25 NEW DIR,X,Y
KILL DIR
+26 SET DIR(0)="SAMO^ADD:ADD;REPLACE:REPLACE"
SET DIR("A")="(A)dd calls to "_LISTNAME_" or (R)eplace "_LISTNAME_" with these calls? "
SET DIR("B")="ADD"
+27 SET DIR("?",1)="Enter ADD to add these calls to the list."
+28 SET DIR("?",2)="Enter REPLACE to have the list only have these calls."
+29 SET DIR("?")="^D HELP^FSCU(.DIR)"
+30 SET DIR("??")="FSC U1 NOIS"
+31 DO ^DIR
KILL DIR
+32 IF $DATA(DIRUT)
QUIT
+33 DO SAVE(LISTNUM,Y)
+34 QUIT
+35 ;
SAVE(LISTNUM,SAVETYPE) ;
+1 NEW CALL,CALLLINE,LISTSNUM,NUM
+2 IF SAVETYPE="REPLACE"
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(LISTSNUM)
+3 IF SAVETYPE="ADD"!(SAVETYPE="REPLACE")
Begin DoDot:1
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSC SELECT",$JOB,"VALUES",NUM))
if NUM<1
QUIT
Begin DoDot:2
+5 SET CALLLINE=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",NUM,0))
+6 SET CALL=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",CALLLINE,0))
DO ADD(CALL,LISTNUM)
End DoDot:2
End DoDot:1
+7 KILL ^TMP("FSC SELECT",$JOB,"VALUES")
+8 QUIT
+9 ;
ADD(CALL,LIST,OK) ; from FSCLP, FSCRPCLO, FSCRPCSL
+1 SET OK=1
IF $DATA(^FSCD("LISTS","ALC",LIST,CALL))
SET OK=0
QUIT
+2 NEW LISTSNUM
SET LISTSNUM=1+$PIECE(^FSCD("LISTS",0),U,3)
+3 ; *** skip
LOCK +^FSCD("LISTS",0):30
IF '$TEST
QUIT
+4 FOR
if '$DATA(^FSCD("LISTS",LISTSNUM,0))
QUIT
SET LISTSNUM=LISTSNUM+1
+5 SET ^FSCD("LISTS",LISTSNUM,0)=CALL_U_LIST
+6 SET $PIECE(^FSCD("LISTS",0),U,3)=LISTSNUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+7 LOCK -^FSCD("LISTS",0)
+8 SET ^FSCD("LISTS","B",CALL,LISTSNUM)=""
+9 SET ^FSCD("LISTS","L",LIST,LISTSNUM)=""
+10 SET ^FSCD("LISTS","ALC",LIST,CALL,LISTSNUM)=""
+11 QUIT
+12 ;
DELETE(DA) ; from FSCLDR, FSCLP, FSCRPCLO, FSCRPCSL
+1 IF 'DA
QUIT
+2 NEW DIK
+3 SET DIK="^FSCD(""LISTS"","
+4 DO ^DIK
+5 QUIT
