- 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 Feb 18, 2025@23:45:04 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