source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCLMPS.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1FSCLMPS ;SLC/STAFF-NOIS List Manager Protocol Save and SaveAs ;9/6/98 21:09
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4ASLD ; from FSCLMP
5 I "AMS"'[$P(^FSC("LIST",FSCLNUM,0),U,3) W !,"You cannot copy this list.",$C(7) H 2 Q
6 N DA,DIC,DIK,DLAYGO,NAME,NEWLNUM,OK,OWNER,X,Y K DIC
7 D NAME^FSCMU("",.NAME,.OK) I 'OK Q
8 D OWNER^FSCMU(+$P($G(^FSC("LIST",FSCLNUM,0)),U,2),.OWNER,.OK) I 'OK Q
9 W ! D ASK^FSCLD(.OK) I 'OK Q
10 I '$G(OWNER) S OWNER=DUZ
11 S (DIC,DLAYGO)=7107.1,DIC(0)="L",X=NAME
12 D ^DIC I '$P(Y,U,3) K DIC W !,"Not defined.",$C(7) H 2 Q
13 S NEWLNUM=+Y
14 W !,"A copy of ",FSCLNAME," is being saved as ",NAME,".",!
15 M ^FSC("LIST",NEWLNUM)=^FSC("LIST",FSCLNUM)
16 S $P(^FSC("LIST",NEWLNUM,0),U)=NAME,$P(^(0),U,2)=OWNER
17 S DIK=DIC,DA=NEWLNUM D IX1^DIK K DIC
18 S FSCLNAME=NAME,FSCLNUM=NEWLNUM
19 L +^XTMP("FSC LIST DEF",FSCLNUM):20 I '$T D BAD^FSCLDS
20 E D BUILD^FSCLDU(FSCLNUM,.OK) I 'OK D BAD^FSCLDS
21 L -^XTMP("FSC LIST DEF",FSCLNUM)
22 D ENTRY^FSCLMM,HEADER^FSCLMM
23 H 1
24 Q
25 ;
26ASLIST ; from FSCLMP
27 N DEFAULT,DIC,LISTNAME,LISTNUM,NUM,X,Y K DIC,^TMP("FSC SELECT",$J,"VALUES")
28 S DIC=7107.1,DIC(0)="AEMOQ"
29 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)")
30 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
31 I '$D(DIC("B")) D
32 .W !,"You do not own any STORAGE-ONLY type lists."
33 .W !,"You can define this type of list using the Define List action (DL)"
34 .W !,"for temporarily storing calls. You can still store calls under any"
35 .W !,"public lists."
36 S DIC("S")="I $P(^(0),U,3)=""S"",$P(^(0),U,2)=DUZ!'$P(^(0),U,2)"
37 S DIC("A")="Save to list: "
38 D ^DIC K DIC I Y<1 Q
39 S LISTNUM=+Y,LISTNAME=$P(Y,U,2),DEFAULT="1-"_+^TMP("FSC LIST CALLS",$J)
40 I DEFAULT="1-0" D Q
41 .N DIR,X,Y K DIR
42 .S DIR(0)="YAO",DIR("A")="Save this list with all calls removed? ",DIR("B")="YES"
43 .S DIR("?",1)="Enter YES to save this as an empty list."
44 .S DIR("?",2)="Enter NO or '^' to exit without saving."
45 .S DIR("?")="^D HELP^FSCU(.DIR)"
46 .S DIR("??")="FSC U1 NOIS"
47 .D ^DIR K DIR
48 .I Y'=1 Q
49 .D SAVE(LISTNUM,"REPLACE")
50 D SELECT^FSCUL(DEFAULT,"",DEFAULT,"VALUES",.OK) I 'OK Q
51 N DIR,X,Y K DIR
52 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"
53 S DIR("?",1)="Enter ADD to add these calls to the list."
54 S DIR("?",2)="Enter REPLACE to have the list only have these calls."
55 S DIR("?")="^D HELP^FSCU(.DIR)"
56 S DIR("??")="FSC U1 NOIS"
57 D ^DIR K DIR
58 I $D(DIRUT) Q
59 D SAVE(LISTNUM,Y)
60 Q
61 ;
62SAVE(LISTNUM,SAVETYPE) ;
63 N CALL,CALLLINE,LISTSNUM,NUM
64 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)
65 I SAVETYPE="ADD"!(SAVETYPE="REPLACE") D
66 .S NUM=0 F S NUM=$O(^TMP("FSC SELECT",$J,"VALUES",NUM)) Q:NUM<1 D
67 ..S CALLLINE=+$O(^TMP("FSC LIST CALLS",$J,"IDX",NUM,0))
68 ..S CALL=+$O(^TMP("FSC LIST CALLS",$J,"ICX",CALLLINE,0)) D ADD(CALL,LISTNUM)
69 K ^TMP("FSC SELECT",$J,"VALUES")
70 Q
71 ;
72ADD(CALL,LIST,OK) ; from FSCLP, FSCRPCLO, FSCRPCSL
73 S OK=1 I $D(^FSCD("LISTS","ALC",LIST,CALL)) S OK=0 Q
74 N LISTSNUM S LISTSNUM=1+$P(^FSCD("LISTS",0),U,3)
75 L +^FSCD("LISTS",0):30 I '$T Q ; *** skip
76 F Q:'$D(^FSCD("LISTS",LISTSNUM,0)) S LISTSNUM=LISTSNUM+1
77 S ^FSCD("LISTS",LISTSNUM,0)=CALL_U_LIST
78 S $P(^FSCD("LISTS",0),U,3)=LISTSNUM,$P(^(0),U,4)=$P(^(0),U,4)+1
79 L -^FSCD("LISTS",0)
80 S ^FSCD("LISTS","B",CALL,LISTSNUM)=""
81 S ^FSCD("LISTS","L",LIST,LISTSNUM)=""
82 S ^FSCD("LISTS","ALC",LIST,CALL,LISTSNUM)=""
83 Q
84 ;
85DELETE(DA) ; from FSCLDR, FSCLP, FSCRPCLO, FSCRPCSL
86 I 'DA Q
87 N DIK
88 S DIK="^FSCD(""LISTS"","
89 D ^DIK
90 Q
Note: See TracBrowser for help on using the repository browser.