source: FOIAVistA/tag/r/NOIS-FSC/FSCRPCA.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1FSCRPCA ;SLC/STAFF-NOIS RPC Add ;3/12/99 14:27
2 ;;1.1;NOIS;**1**;Sep 06, 1998
3 ;
4ALERT(IN,OUT) ; from FSCRPX (RPCAlert)
5 N DATA,NODE,TIME,XQAID,XQAKILL
6 D GETTIME(.TIME) I 'TIME Q
7 S NODE=$G(^XTV(8992,DUZ,"XQA",TIME,0)),DATA=$G(^(1))
8 I '$L(NODE) Q
9 S XQAID=$P(NODE,U,2)
10 I XQAID["FSC-A" D USER^FSCRPCAP
11 I XQAID["FSC-M" D ALERT^FSCRPCAP(DATA)
12 S XQAKILL=1
13 D DELETE^XQALERT
14 Q
15 ;
16GETTIME(TIME) ;
17 N NODEID,SUB
18 S TIME=0
19 S SUB=0 F S SUB=$O(^XTV(8992,DUZ,"XQA",SUB)) Q:SUB<1 D I TIME>0 Q
20 .S NODEID=$P($G(^XTV(8992,DUZ,"XQA",SUB,0)),U,2)
21 .I NODEID["FSC-A" S TIME=SUB Q
22 .I NODEID["FSC-M" S TIME=SUB Q
23 Q
24 ;
25LISTS(IN,OUT) ; from FSCRPX (RPCAddLists)
26 N CALL,COUNT,INDX,INPUT,LCNT,LIMIT,LIMITNUM,LIMITDTO,LIMITDFM,LIST,LNAME,LNUM,MAX,OK,RLIST,TIME
27 S COUNT=0,MAX=$$MAX^FSCRPCL
28 S LNUM=0 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S INPUT=^(LNUM) D Q:COUNT'<MAX
29 .S LIST=+INPUT,INDX=+$P(INPUT,U,2),LIMITNUM=$P(INPUT,U,3),LIMITDTO=$P(INPUT,U,4),LIMITDFM=$P(INPUT,U,5)
30 .I 'LIST Q
31 .D LIST(LIST,INDX,.RLIST,.OK) I 'OK Q
32 .S LNAME=$P(^FSC("LIST",LIST,0),U)
33 .I LNAME="MRE:" D
34 ..S (LIMIT,LCNT)=0,TIME="" F S TIME=$O(^FSCD("MRE","AUTC",INDX,TIME)) Q:TIME="" D Q:LIMIT Q:COUNT'<MAX
35 ...S CALL=0 F S CALL=$O(^FSCD("MRE","AUTC",INDX,TIME,CALL)) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
36 ....I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
37 .E I LNAME="MRA:" D
38 ..S (LIMIT,LCNT)=0,TIME="" F S TIME=$O(^FSCD("MRA","AUTC",INDX,TIME)) Q:TIME="" D Q:LIMIT Q:COUNT'<MAX
39 ...S CALL=0 F S CALL=$O(^FSCD("MRA","AUTC",INDX,TIME,CALL)) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
40 ....I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
41 .E D
42 ..S (LIMIT,LCNT)=0,CALL="A" F S CALL=$O(@RLIST@(CALL),-1) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
43 ...I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
44 D OUTPUT
45 Q
46 ;
47CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,LIMIT,LCNT,COUNT) ;
48 N DATEO
49 I LIMITNUM D
50 .I LCNT'<LIMITNUM S LIMIT=1
51 .E D SETUP(CALL,.COUNT)
52 E I LIMITDTO!LIMITDFM D
53 .S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
54 .I DATEO<LIMITDFM Q
55 .I DATEO>LIMITDTO Q
56 .D SETUP(CALL,.COUNT)
57 E D SETUP(CALL,.COUNT)
58 S LCNT=LCNT+1
59 Q
60 ;
61SETUP(CALL,COUNT) ; from FSCRPCQ, FSCRPCR, FSCRPCS
62 N LNUM
63 S COUNT=COUNT+1
64 S LNUM=1+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
65 I LNUM<1000 S LNUM=LNUM+1000
66 S ^TMP("FSC CURRENT LIST",$J,LNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
67 S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM
68 Q
69 ;
70LIST(LIST,INDX,RLIST,OK) ; from FSCRPCR, FSCRPCS
71 N L0,LNAME S OK=1
72 S L0=$G(^FSC("LIST",LIST,0))
73 I '$L(L0) S OK=0 Q
74 S LNAME=$P(L0,U)
75 I $L($P(L0,U,4)),'$P(L0,U,5) S RLIST="^FSCD(""CALL"","_$P(L0,U,4)_")"
76 E I $L($P(L0,U,4)),INDX S RLIST="^FSCD(""CALL"","_$P(L0,U,4)_","_INDX_")"
77 E I $P(L0,U,3)="M" D
78 .S RLIST="^FSCD(""FSC MLC"","_$J_","_LIST_")"
79 .D MANUAL^FSCLP(LIST)
80 .K ^TMP("FSC LIST",$J)
81 E S RLIST="^FSCD(""LISTS"",""ALC"","_LIST_")"
82 ;D MRU^FSCMR(DUZ,LIST,INDX)
83 Q
84 ;
85CALLS(IN,OUT) ; from FSCRPX (RPCAddCalls)
86 N CALL,NEWNUM,NUM
87 S NEWNUM=+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
88 I NEWNUM<1000 S NEWNUM=NEWNUM+1000
89 S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S CALL=+^(NUM) D
90 .I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D
91 ..S NEWNUM=NEWNUM+1
92 ..S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
93 ..S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
94 D OUTPUT
95 Q
96 ;
97OUTPUT ; from FSCRPCAP, FSCRPCD, FSCRPCQ, FSCRPCR, FSCRPCS
98 N NUM
99 S NUM=0 F S NUM=$O(^TMP("FSC CURRENT LIST",$J,NUM)) Q:NUM<1 S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=^(NUM)
100 Q
101 ;
102INSERT(IN,OUT) ; from FSCRPCX (RPCInsertCall)
103 N CALL,LNUM,NEWNUM
104 S CALL=+^TMP("FSCRPC",$J,"INPUT",1)
105 I 'CALL Q
106 S LNUM=+$O(^TMP("FSC CURRENT LIST",$J,0))
107 I LNUM<1 S NEWNUM=1000
108 E S NEWNUM=LNUM-1
109 F Q:'$D(^TMP("FSC CURRENT LIST",$J,NEWNUM)) S NEWNUM=NEWNUM-1
110 I NEWNUM<1 Q
111 S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
112 S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
113 Q
Note: See TracBrowser for help on using the repository browser.