source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCLMPQA.m@ 1801

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

initial load of WorldVistAEHR

File size: 3.7 KB
RevLine 
[613]1FSCLMPQA ;SLC/STAFF-NOIS List Manager Protocol Query Add ;3/24/98 11:47
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4ADD ; from FSCLMP
5 N DIR,FSCLIMIT,SELECT,X,Y K DIR
6 S VALMCNT=+$P(^TMP("FSC LIST CALLS",$J),U,2) I VALMCNT=0 K ^($J) S ^($J)="0^0"
7 S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;E:Expand"
8 S DIR("A")="Add using: " W !,"(S)elected Calls, (L)ists, (Q)uery, (E)xpand"
9 S DIR("?",1)="Enter S to add to the list specific calls."
10 S DIR("?",2)="Enter L to add to the list calls from other lists."
11 S DIR("?",3)="Enter Q to add to the list calls meeting a specific criteria."
12 S DIR("?",4)="Enter E to to expand list to all duplicates."
13 S DIR("?",5)="Note: changing a list does not change 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="E" D Q
22 ..N CALL,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
23 ..M ^TMP("FSC MERGE",$J)=^TMP("FSC LIST CALLS",$J,"CX")
24 ..K ^TMP("FSC LIST CALLS",$J)
25 ..S ^TMP("FSC LIST CALLS",$J)="0^0"
26 ..S VALMCNT=0
27 ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
28 ...S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
29 ...S ^TMP("FSC MERGE",$J,"CX",PRIMARY)=""
30 ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
31 ...S ^TMP("FSC MERGE",$J,CALL)=""
32 ..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
33 ...S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",CALL,SECOND)) Q:SECOND<1 D
34 ....S ^TMP("FSC MERGE",$J,SECOND)=""
35 ..S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q:CALL="" D
36 ...D SETUP^FSCLMPQU(.VALMCNT,CALL)
37 ..D COUNT^FSCLMPQU(VALMCNT)
38 ..D HDR^FSCLMPQU
39 ..K ^TMP("FSC MERGE",$J)
40 .I SELECT="S" D Q
41 ..N CALL,CALLS,DIC,Y K CALLS,DIC
42 ..S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select Call: "
43 ..F D ^DIC Q:Y<1 S CALLS(+Y)=""
44 ..K DIC
45 ..I '$O(CALLS(0)) Q
46 ..S CALL=0 F S CALL=$O(CALLS(CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D SETUP^FSCLMPQU(.VALMCNT,CALL)
47 ..D COUNT^FSCLMPQU(VALMCNT)
48 .I SELECT="L" D Q
49 ..N CALL,LIMIT,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,RLIST,TIME K LIMITS,LISTS
50 ..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
51 ..I 'OK Q
52 ..I '$O(LISTS(0)) Q
53 ..S LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 S RLIST=LISTS(LISTNUM),FSCLIMIT=LIMITS(LISTNUM) D I $D(VALMQUIT) Q
54 ...S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
55 ...I LNAME="MRE:" D Q
56 ....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
57 .....S CALL=0 F S CALL=$O(^FSCD("MRE","AUTC",LINDX,TIME,CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT
58 ...I LNAME="MRA:" D Q
59 ....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
60 .....S CALL=0 F S CALL=$O(^FSCD("MRA","AUTC",LINDX,TIME,CALL)) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT
61 ...S (LIMIT,LNUM)=0,CALL="A" F S CALL=$O(@RLIST@(CALL),-1) Q:CALL<1 I '$D(^TMP("FSC LIST CALLS",$J,"CX",CALL)) D CHECK(.VALMCNT,CALL,.LIMIT,.LNUM) Q:LIMIT I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
62 ..D COUNT^FSCLMPQU(VALMCNT)
63 .I SELECT="Q" D Q
64 ..D QUERY^FSCLMPQU("Add")
65 I '$D(VALMQUIT) D EMPTY^FSCLMPQU
66 S VALMBG=1
67 Q
68 ;
69CHECK(VALMCNT,CALL,LIMIT,LNUM) ;
70 N DATEO,LIMITOK
71 I $G(FSCLIMIT) S LIMITOK=1 D Q:'LIMITOK
72 .I $P(FSCLIMIT,U,2) S:LNUM'<$P(FSCLIMIT,U,2) LIMIT=1,LIMITOK=0 Q
73 .S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
74 .I DATEO<$P(FSCLIMIT,U,3) S LIMITOK=0 Q
75 .I DATEO>$P(FSCLIMIT,U,4) S LIMITOK=0 Q
76 S LNUM=LNUM+1
77 D SETUP^FSCLMPQU(.VALMCNT,CALL)
78 Q
Note: See TracBrowser for help on using the repository browser.