source: FOIAVistA/tag/r/NOIS-FSC/FSCRPCL.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: 3.8 KB
Line 
1FSCRPCL ;SLC/STAFF-NOIS RPC List ;9/6/98 22:00
2 ;;1.1;NOIS;;Sep 06, 1998
3LIST(IN,OUT) ; from FSCRPX (RPCListCalls)
4 N INPUT,LIMITDFM,LIMITDTO,LIMITNUM,LIST0,LISTINDX,LISTNUM,MAX
5 S INPUT=$G(^TMP("FSCRPC",$J,"INPUT",1))
6 S LISTNUM=+INPUT,LISTINDX=+$P(INPUT,U,2),LIMITNUM=+$P(INPUT,U,3),LIMITDFM=+$P(INPUT,U,4),LIMITDTO=+$P(INPUT,U,5)
7 S LIST0=$G(^FSC("LIST",LISTNUM,0))
8 I '$L(LIST0) Q
9 S MAX=$$MAX
10 D KILLLIST
11 D MRU^FSCMR(DUZ,LISTNUM,LISTINDX)
12 I $E(LIST0,1,4)="MRE:" D MR("MRE",LISTINDX,LIMITNUM,LIMITDTO,LIMITDFM)
13 E I $E(LIST0,1,4)="MRA:" D MR("MRA",LISTINDX,LIMITNUM,LIMITDTO,LIMITDFM)
14 E I $L($P(LIST0,U,4)) D INDEX(LIST0,MAX,LISTINDX,LIMITNUM,LIMITDTO,LIMITDFM)
15 E I $P(LIST0,U,3)="M" D MANUAL(MAX,LISTNUM,LIMITNUM,LIMITDTO,LIMITDFM)
16 E D OTHER(MAX,LISTNUM,LIMITNUM,LIMITDTO,LIMITDFM)
17 Q
18 ;
19MR(NODE,LISTINDX,LIMITNUM,LIMITDTO,LIMITDFM) ;
20 N CALL,DATEO,LNUM,TIME
21 S LNUM=0
22 I LIMITNUM D
23 .S TIME="" F S TIME=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME)) Q:TIME="" D I LNUM'<LIMITNUM Q
24 ..S CALL=0 F S CALL=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME,CALL)) Q:CALL<1 D SETUP(CALL,.LNUM) I LNUM'<LIMITNUM Q
25 E I LIMITDTO!LIMITDFM D
26 .S TIME="" F S TIME=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME)) Q:TIME="" D
27 ..S CALL=0 F S CALL=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME,CALL)) Q:CALL<1 D
28 ...S DATE0=$P(^FSCD("CALL",CALL,0),U,3)
29 ...I DATEO<LIMITDFM Q
30 ...I DATEO>LIMITDTO Q
31 ...D SETUP(CALL,.LNUM)
32 E D
33 .S TIME="" F S TIME=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME)) Q:TIME="" D
34 ..S CALL=0 F S CALL=$O(^FSCD(NODE,"AUTC",LISTINDX,TIME,CALL)) Q:CALL<1 D SETUP(CALL,.LNUM)
35 Q
36 ;
37INDEX(LIST0,MAX,LISTINDX,LIMITNUM,LIMITDTO,LIMITDFM) ;
38 N CALL,DATEO,LNUM,SOURCE
39 S LNUM=0
40 S SOURCE="^FSCD(""CALL"","_$P(LIST0,U,4)_$S(LISTINDX:","_LISTINDX,1:"")_")"
41 I LIMITNUM D
42 .S CALL="A" F S CALL=$O(@SOURCE@(CALL),-1) Q:CALL<1 D SETUP(CALL,.LNUM) Q:LNUM'<LIMITNUM Q:LNUM'<MAX
43 E I LIMITDTO!LIMITDFM D
44 .S CALL="A" F S CALL=$O(@SOURCE@(CALL),-1) Q:CALL<1 D Q:LNUM'<MAX
45 ..S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
46 ..I DATEO<LIMITDFM Q
47 ..I DATEO>LIMITDTO Q
48 ..D SETUP(CALL,.LNUM)
49 E D
50 .S CALL="A" F S CALL=$O(@SOURCE@(CALL),-1) Q:CALL<1 D SETUP(CALL,.LNUM) Q:LNUM'<MAX
51 Q
52 ;
53MANUAL(MAX,LISTNUM,LIMITNUM,LIMITDTO,LIMITDFM) ;
54 N CALL,DATEO,LNUM
55 K ^TMP("FSC LIST",$J)
56 S LNUM=0
57 D MANUAL^FSCLP(LISTNUM)
58 I LIMITNUM D
59 .S CALL="A" F S CALL=$O(^TMP("FSC LIST",$J,CALL),-1) Q:CALL<1 D SETUP(CALL,.LNUM) Q:LNUM'<LIMITNUM Q:LNUM'<MAX
60 E I LIMITDTO!LIMITDFM D
61 .S CALL="A" F S CALL=$O(^TMP("FSC LIST",$J,CALL),-1) Q:CALL<1 D Q:LNUM'<MAX
62 ..S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
63 ..I DATEO<LIMITDFM Q
64 ..I DATEO>LIMITDTO Q
65 ..D SETUP(CALL,.LNUM)
66 E D
67 .S CALL="A" F S CALL=$O(^TMP("FSC LIST",$J,CALL),-1) Q:CALL<1 D SETUP(CALL,.LNUM) Q:LNUM'<MAX
68 K ^TMP("FSC LIST",$J)
69 Q
70 ;
71OTHER(MAX,LISTNUM,LIMITNUM,LIMITDTO,LIMITDFM) ;
72 N CALL,DATEO,LISTCALL,LNUM
73 S LNUM=0
74 I LIMITNUM D
75 .S LISTCALL="A" F S LISTCALL=$O(^FSCD("LISTS","L",LISTNUM,LISTCALL),-1) Q:LISTCALL<1 S CALL=+$G(^FSCD("LISTS",LISTCALL,0)) D SETUP(CALL,.LNUM) Q:LNUM'<LIMITNUM Q:LNUM'<MAX
76 E I LIMITDTO!LIMITDFM D
77 .S LISTCALL="A" F S LISTCALL=$O(^FSCD("LISTS","L",LISTNUM,LISTCALL),-1) Q:LISTCALL<1 D Q:LNUM'<MAX
78 ..S CALL=+$G(^FSCD("LISTS",LISTCALL,0))
79 ..S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
80 ..I DATEO<LIMITDFM Q
81 ..I DATEO>LIMITDTO Q
82 ..D SETUP(CALL,.LNUM)
83 E D
84 .S LISTCALL="A" F S LISTCALL=$O(^FSCD("LISTS","L",LISTNUM,LISTCALL),-1) Q:LISTCALL<1 S CALL=+$G(^FSCD("LISTS",LISTCALL,0)) D SETUP(CALL,.LNUM) Q:LNUM'<MAX
85 Q
86 ;
87SETUP(CALL,LNUM) ;
88 S LNUM=LNUM+1
89 S (^TMP("FSC CURRENT LIST",$J,LNUM+1000),^TMP("FSCRPC",$J,"OUTPUT",LNUM))=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
90 S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM+1000
91 Q
92 ;
93MAX() ; $$ -> max number of calls to return
94 I $P($G(^FSC("PARAM",1,2)),U,2) Q +$P(^(2),U,2)
95 Q 1000
96 ;
97CLEAR(IN,OUT) ; from FSCRPX (RPCClearList)
98 D KILLLIST
99 Q
100 ;
101KILLLIST ; from FSCRPCLO
102 K ^TMP("FSC CURRENT LIST",$J)
103 Q
Note: See TracBrowser for help on using the repository browser.