FSCLMPQA ;SLC/STAFF-NOIS List Manager Protocol Query Add ;3/24/98 11:47
;;1.1;NOIS;;Sep 06, 1998
;
ADD ; from FSCLMP
N DIR,FSCLIMIT,SELECT,X,Y K DIR
S VALMCNT=+$P(^TMP("FSC LIST CALLS",$J),U,2) I VALMCNT=0 K ^($J) S ^($J)="0^0"
S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;E:Expand"
S DIR("A")="Add using: " W !,"(S)elected Calls, (L)ists, (Q)uery, (E)xpand"
S DIR("?",1)="Enter S to add to the list specific calls."
S DIR("?",2)="Enter L to add to the list calls from other lists."
S DIR("?",3)="Enter Q to add to the list calls meeting a specific criteria."
S DIR("?",4)="Enter E to to expand list to all duplicates."
S DIR("?",5)="Note: changing a list does not change calls stored on the list."
S DIR("?",6)="When a list is changed it appears as (MODIFIED)."
S DIR("?",7)="Enter '^' to exit without changing the list or '??' for more help."
S DIR("?")="^D HELP^FSCU(.DIR)"
S DIR("??")="FSC U1 NOIS"
D ^DIR K DIR
S SELECT=Y
D
.I SELECT="E" D Q
..N CALL,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
..M ^TMP("FSC MERGE",$J)=^TMP("FSC LIST CALLS",$J,"CX")
..K ^TMP("FSC LIST CALLS",$J)
..S ^TMP("FSC LIST CALLS",$J)="0^0"
..S VALMCNT=0
..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
...S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
...S ^TMP("FSC MERGE",$J,"CX",PRIMARY)=""
..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
...S ^TMP("FSC MERGE",$J,CALL)=""
..S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
...S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",CALL,SECOND)) Q:SECOND<1 D
....S ^TMP("FSC MERGE",$J,SECOND)=""
..S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q:CALL="" D
...D SETUP^FSCLMPQU(.VALMCNT,CALL)
..D COUNT^FSCLMPQU(VALMCNT)
..D HDR^FSCLMPQU
..K ^TMP("FSC MERGE",$J)
.I SELECT="S" D Q
..N CALL,CALLS,DIC,Y K CALLS,DIC
..S DIC=7100,DIC(0)="AEMOQ",DIC("A")="Select Call: "
..F D ^DIC Q:Y<1 S CALLS(+Y)=""
..K DIC
..I '$O(CALLS(0)) Q
..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)
..D COUNT^FSCLMPQU(VALMCNT)
.I SELECT="L" D Q
..N CALL,LIMIT,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,RLIST,TIME K LIMITS,LISTS
..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
..I 'OK Q
..I '$O(LISTS(0)) Q
..S LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 S RLIST=LISTS(LISTNUM),FSCLIMIT=LIMITS(LISTNUM) D I $D(VALMQUIT) Q
...S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
...I LNAME="MRE:" D Q
....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
.....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
...I LNAME="MRA:" D Q
....S (LIMIT,LNUM)=0,TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:LIMIT
.....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
...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
..D COUNT^FSCLMPQU(VALMCNT)
.I SELECT="Q" D Q
..D QUERY^FSCLMPQU("Add")
I '$D(VALMQUIT) D EMPTY^FSCLMPQU
S VALMBG=1
Q
;
CHECK(VALMCNT,CALL,LIMIT,LNUM) ;
N DATEO,LIMITOK
I $G(FSCLIMIT) S LIMITOK=1 D Q:'LIMITOK
.I $P(FSCLIMIT,U,2) S:LNUM'<$P(FSCLIMIT,U,2) LIMIT=1,LIMITOK=0 Q
.S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
.I DATEO<$P(FSCLIMIT,U,3) S LIMITOK=0 Q
.I DATEO>$P(FSCLIMIT,U,4) S LIMITOK=0 Q
S LNUM=LNUM+1
D SETUP^FSCLMPQU(.VALMCNT,CALL)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPQA 3839 printed Apr 09, 2024@21:21:57 Page 2
FSCLMPQA ;SLC/STAFF-NOIS List Manager Protocol Query Add ;3/24/98 11:47
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ADD ; from FSCLMP
+1 NEW DIR,FSCLIMIT,SELECT,X,Y
KILL DIR
+2 SET VALMCNT=+$PIECE(^TMP("FSC LIST CALLS",$JOB),U,2)
IF VALMCNT=0
KILL ^($JOB)
SET ^($JOB)="0^0"
+3 SET DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;E:Expand"
+4 SET DIR("A")="Add using: "
WRITE !,"(S)elected Calls, (L)ists, (Q)uery, (E)xpand"
+5 SET DIR("?",1)="Enter S to add to the list specific calls."
+6 SET DIR("?",2)="Enter L to add to the list calls from other lists."
+7 SET DIR("?",3)="Enter Q to add to the list calls meeting a specific criteria."
+8 SET DIR("?",4)="Enter E to to expand list to all duplicates."
+9 SET DIR("?",5)="Note: changing a list does not change calls stored on the list."
+10 SET DIR("?",6)="When a list is changed it appears as (MODIFIED)."
+11 SET DIR("?",7)="Enter '^' to exit without changing the list or '??' for more help."
+12 SET DIR("?")="^D HELP^FSCU(.DIR)"
+13 SET DIR("??")="FSC U1 NOIS"
+14 DO ^DIR
KILL DIR
+15 SET SELECT=Y
+16 Begin DoDot:1
+17 IF SELECT="E"
Begin DoDot:2
+18 NEW CALL,PRIMARY,SECOND
KILL ^TMP("FSC MERGE",$JOB)
+19 MERGE ^TMP("FSC MERGE",$JOB)=^TMP("FSC LIST CALLS",$JOB,"CX")
+20 KILL ^TMP("FSC LIST CALLS",$JOB)
+21 SET ^TMP("FSC LIST CALLS",$JOB)="0^0"
+22 SET VALMCNT=0
+23 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL))
if CALL<1
QUIT
Begin DoDot:3
+24 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALL,120)),U,24)
IF 'PRIMARY
QUIT
+25 SET ^TMP("FSC MERGE",$JOB,"CX",PRIMARY)=""
End DoDot:3
+26 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
if CALL<1
QUIT
Begin DoDot:3
+27 SET ^TMP("FSC MERGE",$JOB,CALL)=""
End DoDot:3
+28 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
if CALL<1
QUIT
Begin DoDot:3
+29 SET SECOND=0
FOR
SET SECOND=$ORDER(^FSCD("CALL","APRIMARY",CALL,SECOND))
if SECOND<1
QUIT
Begin DoDot:4
+30 SET ^TMP("FSC MERGE",$JOB,SECOND)=""
End DoDot:4
End DoDot:3
+31 SET CALL="A"
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL),-1)
if CALL=""
QUIT
Begin DoDot:3
+32 DO SETUP^FSCLMPQU(.VALMCNT,CALL)
End DoDot:3
+33 DO COUNT^FSCLMPQU(VALMCNT)
+34 DO HDR^FSCLMPQU
+35 KILL ^TMP("FSC MERGE",$JOB)
End DoDot:2
QUIT
+36 IF SELECT="S"
Begin DoDot:2
+37 NEW CALL,CALLS,DIC,Y
KILL CALLS,DIC
+38 SET DIC=7100
SET DIC(0)="AEMOQ"
SET DIC("A")="Select Call: "
+39 FOR
DO ^DIC
if Y<1
QUIT
SET CALLS(+Y)=""
+40 KILL DIC
+41 IF '$ORDER(CALLS(0))
QUIT
+42 SET CALL=0
FOR
SET CALL=$ORDER(CALLS(CALL))
if CALL<1
QUIT
IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
DO SETUP^FSCLMPQU(.VALMCNT,CALL)
+43 DO COUNT^FSCLMPQU(VALMCNT)
End DoDot:2
QUIT
+44 IF SELECT="L"
Begin DoDot:2
+45 NEW CALL,LIMIT,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,RLIST,TIME
KILL LIMITS,LISTS
+46 DO LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
+47 IF 'OK
QUIT
+48 IF '$ORDER(LISTS(0))
QUIT
+49 SET LISTNUM=0
FOR
SET LISTNUM=$ORDER(LISTS(LISTNUM))
if LISTNUM<1
QUIT
SET RLIST=LISTS(LISTNUM)
SET FSCLIMIT=LIMITS(LISTNUM)
Begin DoDot:3
+50 SET LNAME=$PIECE(^FSC("LIST",+$PIECE(LISTNUM,"."),0),U)
SET LINDX=+$PIECE(LISTNUM,".",2)
+51 IF LNAME="MRE:"
Begin DoDot:4
+52 SET (LIMIT,LNUM)=0
SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME))
if TIME=""
QUIT
Begin DoDot:5
+53 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME,CALL))
if CALL<1
QUIT
IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
if LIMIT
QUIT
End DoDot:5
if LIMIT
QUIT
End DoDot:4
QUIT
+54 IF LNAME="MRA:"
Begin DoDot:4
+55 SET (LIMIT,LNUM)=0
SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME))
if TIME=""
QUIT
Begin DoDot:5
+56 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME,CALL))
if CALL<1
QUIT
IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
if LIMIT
QUIT
End DoDot:5
if LIMIT
QUIT
End DoDot:4
QUIT
+57 SET (LIMIT,LNUM)=0
SET CALL="A"
FOR
SET CALL=$ORDER(@RLIST@(CALL),-1)
if CALL<1
QUIT
IF '$DATA(^TMP("FSC LIST CALLS",$JOB,"CX",CALL))
DO CHECK(.VALMCNT,CALL,.LIMIT,.LNUM)
if LIMIT
QUIT
IF (VALMCNT#10)=0
DO CHECK^FSCLML(.VALMQUIT)
IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
End DoDot:3
IF $DATA(VALMQUIT)
QUIT
+58 DO COUNT^FSCLMPQU(VALMCNT)
End DoDot:2
QUIT
+59 IF SELECT="Q"
Begin DoDot:2
+60 DO QUERY^FSCLMPQU("Add")
End DoDot:2
QUIT
End DoDot:1
+61 IF '$DATA(VALMQUIT)
DO EMPTY^FSCLMPQU
+62 SET VALMBG=1
+63 QUIT
+64 ;
CHECK(VALMCNT,CALL,LIMIT,LNUM) ;
+1 NEW DATEO,LIMITOK
+2 IF $GET(FSCLIMIT)
SET LIMITOK=1
Begin DoDot:1
+3 IF $PIECE(FSCLIMIT,U,2)
if LNUM'<$PIECE(FSCLIMIT,U,2)
SET LIMIT=1
SET LIMITOK=0
QUIT
+4 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
+5 IF DATEO<$PIECE(FSCLIMIT,U,3)
SET LIMITOK=0
QUIT
+6 IF DATEO>$PIECE(FSCLIMIT,U,4)
SET LIMITOK=0
QUIT
End DoDot:1
if 'LIMITOK
QUIT
+7 SET LNUM=LNUM+1
+8 DO SETUP^FSCLMPQU(.VALMCNT,CALL)
+9 QUIT
