source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCLMPQS.m@ 1240

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1FSCLMPQS ;SLC/STAFF-NOIS List Manager Protocol Query Select ;1/13/98 13:08
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4SELECT ; from FSCLMP
5 I '^TMP("FSC LIST CALLS",$J) W !,$C(7),"You can't select from an empty list." H 2 Q
6 N DIR,SELECT,X,Y K DIR
7 S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query"
8 S DIR("A")="Select using: " W !,"(S)elected Calls, (L)ists, (Q)uery"
9 S DIR("?",1)="Enter S to select calls from the list that will remain on the list."
10 S DIR("?",2)="Enter L to allow calls that are on selected lists to remain."
11 S DIR("?",3)="Enter Q to specify which calls will remain on the list by entering"
12 S DIR("?",4)="a query (filter for calls meeting a criteria)."
13 S DIR("?",5)="Note: changing a list does not change the calls stored on the list."
14 S DIR("?",6)="When a list is changed it appears as (MODIFIED)."
15 S DIR("?",7)="Enter '^' to exit without changing the list or '??' for more help."
16 S DIR("?")="^D HELP^FSCU(.DIR)"
17 S DIR("??")="FSC U1 NOIS"
18 D ^DIR K DIR
19 S SELECT=Y
20 D
21 .I SELECT="S" D Q
22 ..N CALL,CHOICE,DEFAULT,LNUM,OK
23 ..K ^TMP("FSC SELECT",$J,"RVALUES")
24 ..S CHOICE="1-"_+@VALMAR,DEFAULT="" D SELECT^FSCUL(CHOICE,"",DEFAULT,"RVALUES",.OK)
25 ..I '$O(^TMP("FSC SELECT",$J,"RVALUES",0)) Q
26 ..W !
27 ..S LNUM=0 F S LNUM=$O(^TMP("FSC SELECT",$J,"RVALUES",LNUM)) Q:LNUM<1 D
28 ...S CALL=+$O(^TMP("FSC LIST CALLS",$J,"ICX",+$O(^TMP("FSC LIST CALLS",$J,"IDX",LNUM,0)),0))
29 ...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
30 ..K ^TMP("FSC LIST CALLS",$J)
31 ..S (LNUM,VALMCNT)=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=+$O(^(LNUM,0)) D SETUP^FSCLMPQU(.VALMCNT,CALL)
32 ..D COUNT^FSCLMPQU(VALMCNT)
33 ..K ^TMP("FSC MERGE",$J),^TMP("FSC SELECT",$J,"RVALUES")
34 .I SELECT="L" D Q
35 ..N CALL,CALLX,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,TIME K LIMITS,LISTS
36 ..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
37 ..I '$O(LISTS(0)) Q
38 ..W !
39 ..S LNUM=0 F S LNUM=$O(^TMP("FSC LIST CALLS",$J,"ICX",LNUM)) Q:LNUM<1 S CALL=+$O(^(LNUM,0)) D
40 ...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
41 ..K ^TMP("FSC LIST CALLS",$J)
42 ..S (LNUM,VALMCNT)=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=$O(^(LNUM,0)) D I $D(VALMQUIT) Q
43 ...S OK=0,LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 D I OK Q
44 ....S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
45 ....I LNAME="MRE:" D Q
46 .....S TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:OK
47 ......S CALLX=0 F S CALLX=$O(^FSCD("MRE","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=1 Q
48 ....I LNAME="MRA:" D Q
49 .....S TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:OK
50 ......S CALLX=0 F S CALLX=$O(^FSCD("MRA","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=1 Q
51 ....I $D(@LISTS(LISTNUM)@(CALL)) D CHECK(CALL,LISTS(LISTNUM),LIMITS(LISTNUM),.OK)
52 ...I OK D SETUP^FSCLMPQU(.VALMCNT,CALL) I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
53 ..D COUNT^FSCLMPQU(VALMCNT)
54 ..K ^TMP("FSC MERGE",$J)
55 .I SELECT="Q" D Q
56 ..D QUERY^FSCLMPQU("Select")
57 I '$D(VALMQUIT) D EMPTY^FSCLMPQU
58 S VALMBG=1
59 Q
60 ;
61CHECK(CALL,LIST,LIMIT,OK) ;
62 N CNT,DATEO,NUM
63 I 'LIMIT S OK=1 Q
64 S OK=0
65 I $P(LIMIT,U,2) D Q
66 .S CNT=0,NUM="A" F S NUM=$O(@LIST@(NUM),-1) Q:NUM<1 S CNT=CNT+1 I NUM=CALL S:CNT'>$P(LIMIT,U,2) OK=1 Q
67 S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
68 I DATEO'<$P(LIMIT,U,3),DATEO'>$P(LIMIT,U,4) S OK=1
69 Q
Note: See TracBrowser for help on using the repository browser.