source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCLO.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: 2.9 KB
Line 
1FSCRPCLO ;SLC/STAFF-NOIS RPC List Organizer ;4/20/98 13:29
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4LOADLIST(IN,OUT) ; from FSCRPX (RPCLoadCurrentList)
5 N CALL,CNT,LINE,LNUM
6 S CNT=0
7 S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
8 .S CNT=CNT+1
9 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$TEXTID(CALL)
10 Q
11 ;
12RENAME(IN,OUT) ; from FSCRPX (RPCRenameList)
13 N DA,DATA,DIE,DR,LIST,NAME,X,Y
14 S DATA=$G(^TMP("FSCRPC",$J,"INPUT",1))
15 S LIST=+DATA,NAME=$P(DATA,U,2)
16 I '$D(^FSC("LIST",LIST,0)) Q
17 I $L(NAME)<3 Q
18 S DA=LIST,DIE="^FSC(""LIST"",",DR=".01///"_$$FIX^FSCRPCEC($E(NAME,1,30))
19 D ^DIE
20 Q
21 ;
22UPLIST(IN,OUT) ; from FSCRPX (RPCUpdateCurrentList)
23 N CNT,LINE,LNUM
24 S CNT=0
25 S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S LINE=^(LNUM) D
26 .S CNT=CNT+1
27 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
28 Q
29 ;
30DELLIST(IN,OUT) ; from FSCRPX (RPCDeleteList)
31 N CALL,DA,DIE,DIK,DR,LISTNUM,LISTSNUM,SPEC
32 S LISTNUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
33 I '$D(^FSC("LIST","C",DUZ,LISTNUM)) Q
34 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)
35 S DIE=7105.2,DR="9///@"
36 S SPEC=0 F S SPEC=$O(^FSC("SPEC","AL",LISTNUM,SPEC)) Q:SPEC<1 D
37 .S DA=SPEC
38 .L +^FSC("SPEC",SPEC):30
39 .D ^DIE
40 .L -^FSC("SPEC",SPEC)
41 N DA,DIK,NOTIFY
42 S DIK="^FSCD(""NOTIFY"","
43 S NOTIFY=0 F S NOTIFY=$O(^FSCD("NOTIFY","ALIST",LISTNUM,NOTIFY)) Q:NOTIFY<1 D
44 .S DA=NOTIFY
45 .L +^FSCD("NOTIFY",NOTIFY):30
46 .D ^DIK
47 .L -^FSCD("NOTIFY",NOTIFY)
48 D DELMRU^FSCLDR(LISTNUM)
49 S DA=LISTNUM,DIK="^FSC(""LIST""," D ^DIK
50 Q
51 ;
52DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
53 Q
54 ;
55LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
56 N CALL,CNT,LIST,LISTNAME
57 S CNT=0
58 S LIST=0 F S LIST=$O(^FSC("LIST","C",DUZ,LIST)) Q:LIST<1 D
59 .Q:$P($G(^FSC("LIST",LIST,0)),U,3)'="S" S LISTNAME=$P(^(0),U)
60 .S CNT=CNT+1
61 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LIST_"^-1^"_LISTNAME
62 .S CALL="" F S CALL=$O(^FSCD("LISTS","ALC",LIST,CALL),-1) Q:CALL="" D
63 ..S CNT=CNT+1
64 ..S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LIST_U_CALL_U_$$TEXTID(CALL)
65 Q
66 ;
67TEXTID(CALL) ; $$(call) -> text for tree display
68 Q $P(^FSCD("CALL",CALL,0),U)_" "_$G(^FSCD("CALL",CALL,1))
69 ;
70SAVELIST(IN,OUT) ; from FSCRPX (RPCSaveOrganizer)
71 N CALL,LINE,LIST,LNUM,NUM,SCALL,SLIST K SLIST
72 D KILLLIST^FSCRPCL
73 S LNUM=0
74 S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) I $L(LINE) D
75 .S LIST=$P(LINE,U),CALL=$P(LINE,U,2)
76 .I LIST="C" D Q
77 ..S LNUM=LNUM+1
78 ..S ^TMP("FSC CURRENT LIST",$J,LNUM+1000)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
79 ..S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM+1000
80 .I '$D(^FSC("LIST","C",DUZ,LIST)) Q
81 .I '$D(SLIST(LIST)) D
82 ..S SLIST(LIST)=""
83 ..S SCALL=0 F S SCALL=$O(^FSCD("LISTS","ALC",LIST,SCALL)) Q:SCALL<1 S LISTSNUM=+$O(^(SCALL,0)) I LISTSNUM D DELETE^FSCLMPS(LISTSNUM)
84 .I CALL>0,$D(^FSCD("CALL",CALL,0)) D ADD^FSCLMPS(CALL,LIST)
85 K SLIST
86 Q
87 ;
88TEST ;
89 D LOADTREE(.IN,.OUT)
90 Q
Note: See TracBrowser for help on using the repository browser.