FSCLMPQR ;SLC/STAFF-NOIS List Manager Protocol Query Remove ;1/13/98 13:06
;;1.1;NOIS;;Sep 06, 1998
;
REMOVE ; from FSCLMP
I '^TMP("FSC LIST CALLS",$J) W !,$C(7),"You can't delete from an empty list." H 2 Q
N DIR,SELECT,X,Y K DIR
S DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;A:All Calls"
S DIR("A")="Remove using: " W !,"(S)elected Calls, (L)ists, (Q)uery, (A)ll Calls"
S DIR("?",1)="Enter S to a remove selected calls from the last."
S DIR("?",2)="Enter L to remove calls from the list that are on selected lists."
S DIR("?",3)="Enter Q to remove calls from the list using a specific criteria."
S DIR("?",4)="Enter A to remove all calls on the list."
S DIR("?",5)="Note: changing a list does not change what is 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="S" D Q
..N CALL,CHOICE,DEFAULT,LNUM,OK
..K ^TMP("FSC SELECT",$J,"RVALUES")
..S CHOICE="1-"_+@VALMAR,DEFAULT="" D SELECT^FSCUL(CHOICE,"",DEFAULT,"RVALUES",.OK)
..I '$O(^TMP("FSC SELECT",$J,"RVALUES",0)) Q
..W !
..S LNUM=0 F S LNUM=$O(^TMP("FSC LIST CALLS",$J,"IDX",LNUM)) Q:LNUM<1 S CALL=+$O(^TMP("FSC LIST CALLS",$J,"ICX",+$O(^(LNUM,0)),0)) D
...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
..K ^TMP("FSC LIST CALLS",$J)
..S (LNUM,VALMCNT)=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=$O(^(LNUM,0)) D
...I '$D(^TMP("FSC SELECT",$J,"RVALUES",LNUM)) D SETUP^FSCLMPQU(.VALMCNT,CALL)
..D COUNT^FSCLMPQU(VALMCNT)
..K ^TMP("FSC MERGE",$J),^TMP("FSC SELECT",$J,"RVALUES")
.I SELECT="A" D Q
..K ^TMP("FSC LIST CALLS",$J)
..S ^TMP("FSC LIST CALLS",$J)="0^0"
..D HDR^FSCLMPQU
.I SELECT="L" D Q
..N CALL,CALLX,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,TIME K LIMITS,LISTS
..D LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
..I '$O(LISTS(0)) Q
..W !
..S LNUM=0 F S LNUM=$O(^TMP("FSC LIST CALLS",$J,"ICX",LNUM)) Q:LNUM<1 S CALL=+$O(^(LNUM,0)) D
...S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
..K ^TMP("FSC LIST CALLS",$J)
..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
...S OK=1,LISTNUM=0 F S LISTNUM=$O(LISTS(LISTNUM)) Q:LISTNUM<1 D I 'OK Q
....S LNAME=$P(^FSC("LIST",+$P(LISTNUM,"."),0),U),LINDX=+$P(LISTNUM,".",2)
....I LNAME="MRE:" D Q
.....S TIME="" F S TIME=$O(^FSCD("MRE","AUTC",LINDX,TIME)) Q:TIME="" D Q:'OK
......S CALLX=0 F S CALLX=$O(^FSCD("MRE","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=0 Q
....I LNAME="MRA:" D Q
.....S TIME="" F S TIME=$O(^FSCD("MRA","AUTC",LINDX,TIME)) Q:TIME="" D Q:'OK
......S CALLX=0 F S CALLX=$O(^FSCD("MRA","AUTC",LINDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=0 Q
....I $D(@LISTS(LISTNUM)@(CALL)) D CHECK(CALL,LISTS(LISTNUM),LIMITS(LISTNUM),.OK)
...I OK D SETUP^FSCLMPQU(.VALMCNT,CALL) I (VALMCNT#10)=0 D CHECK^FSCLML(.VALMQUIT) I $D(VALMQUIT) S VALMBCK="Q" Q
..D COUNT^FSCLMPQU(VALMCNT)
..K ^TMP("FSC MERGE",$J)
.I SELECT="Q" D Q
..D QUERY^FSCLMPQU("Remove")
I '$D(VALMQUIT) D EMPTY^FSCLMPQU
S VALMBG=1
Q
;
CHECK(CALL,LIST,LIMIT,OK) ;
N CNT,DATEO,NUM
I 'LIMIT S OK=0 Q
S OK=1
I $P(LIMIT,U,2) D Q
.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=0 Q
S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
I DATEO'<$P(LIMIT,U,3),DATEO'>$P(LIMIT,U,4) S OK=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCLMPQR 3523 printed Dec 13, 2024@02:18:34 Page 2
FSCLMPQR ;SLC/STAFF-NOIS List Manager Protocol Query Remove ;1/13/98 13:06
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
REMOVE ; from FSCLMP
+1 IF '^TMP("FSC LIST CALLS",$JOB)
WRITE !,$CHAR(7),"You can't delete from an empty list."
HANG 2
QUIT
+2 NEW DIR,SELECT,X,Y
KILL DIR
+3 SET DIR(0)="SAMO^S:Selected Calls;L:Lists;Q:Query;A:All Calls"
+4 SET DIR("A")="Remove using: "
WRITE !,"(S)elected Calls, (L)ists, (Q)uery, (A)ll Calls"
+5 SET DIR("?",1)="Enter S to a remove selected calls from the last."
+6 SET DIR("?",2)="Enter L to remove calls from the list that are on selected lists."
+7 SET DIR("?",3)="Enter Q to remove calls from the list using a specific criteria."
+8 SET DIR("?",4)="Enter A to remove all calls on the list."
+9 SET DIR("?",5)="Note: changing a list does not change what is 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="S"
Begin DoDot:2
+18 NEW CALL,CHOICE,DEFAULT,LNUM,OK
+19 KILL ^TMP("FSC SELECT",$JOB,"RVALUES")
+20 SET CHOICE="1-"_+@VALMAR
SET DEFAULT=""
DO SELECT^FSCUL(CHOICE,"",DEFAULT,"RVALUES",.OK)
+21 IF '$ORDER(^TMP("FSC SELECT",$JOB,"RVALUES",0))
QUIT
+22 WRITE !
+23 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",LNUM))
if LNUM<1
QUIT
SET CALL=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",+$ORDER(^(LNUM,0)),0))
Begin DoDot:3
+24 SET ^TMP("FSC MERGE",$JOB,LNUM,CALL)=""
End DoDot:3
+25 KILL ^TMP("FSC LIST CALLS",$JOB)
+26 SET (LNUM,VALMCNT)=0
FOR
SET LNUM=$ORDER(^TMP("FSC MERGE",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=$ORDER(^(LNUM,0))
Begin DoDot:3
+27 IF '$DATA(^TMP("FSC SELECT",$JOB,"RVALUES",LNUM))
DO SETUP^FSCLMPQU(.VALMCNT,CALL)
End DoDot:3
+28 DO COUNT^FSCLMPQU(VALMCNT)
+29 KILL ^TMP("FSC MERGE",$JOB),^TMP("FSC SELECT",$JOB,"RVALUES")
End DoDot:2
QUIT
+30 IF SELECT="A"
Begin DoDot:2
+31 KILL ^TMP("FSC LIST CALLS",$JOB)
+32 SET ^TMP("FSC LIST CALLS",$JOB)="0^0"
+33 DO HDR^FSCLMPQU
End DoDot:2
QUIT
+34 IF SELECT="L"
Begin DoDot:2
+35 NEW CALL,CALLX,LIMITS,LINDX,LISTNUM,LISTS,LNAME,LNUM,OK,TIME
KILL LIMITS,LISTS
+36 DO LIST^FSCLMPQU(.LISTS,.LIMITS,.OK)
+37 IF '$ORDER(LISTS(0))
QUIT
+38 WRITE !
+39 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC LIST CALLS",$JOB,"ICX",LNUM))
if LNUM<1
QUIT
SET CALL=+$ORDER(^(LNUM,0))
Begin DoDot:3
+40 SET ^TMP("FSC MERGE",$JOB,LNUM,CALL)=""
End DoDot:3
+41 KILL ^TMP("FSC LIST CALLS",$JOB)
+42 SET (LNUM,VALMCNT)=0
FOR
SET LNUM=$ORDER(^TMP("FSC MERGE",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=$ORDER(^(LNUM,0))
Begin DoDot:3
+43 SET OK=1
SET LISTNUM=0
FOR
SET LISTNUM=$ORDER(LISTS(LISTNUM))
if LISTNUM<1
QUIT
Begin DoDot:4
+44 SET LNAME=$PIECE(^FSC("LIST",+$PIECE(LISTNUM,"."),0),U)
SET LINDX=+$PIECE(LISTNUM,".",2)
+45 IF LNAME="MRE:"
Begin DoDot:5
+46 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME))
if TIME=""
QUIT
Begin DoDot:6
+47 SET CALLX=0
FOR
SET CALLX=$ORDER(^FSCD("MRE","AUTC",LINDX,TIME,CALLX))
if CALLX<1
QUIT
IF CALLX=CALL
SET OK=0
QUIT
End DoDot:6
if 'OK
QUIT
End DoDot:5
QUIT
+48 IF LNAME="MRA:"
Begin DoDot:5
+49 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME))
if TIME=""
QUIT
Begin DoDot:6
+50 SET CALLX=0
FOR
SET CALLX=$ORDER(^FSCD("MRA","AUTC",LINDX,TIME,CALLX))
if CALLX<1
QUIT
IF CALLX=CALL
SET OK=0
QUIT
End DoDot:6
if 'OK
QUIT
End DoDot:5
QUIT
+51 IF $DATA(@LISTS(LISTNUM)@(CALL))
DO CHECK(CALL,LISTS(LISTNUM),LIMITS(LISTNUM),.OK)
End DoDot:4
IF 'OK
QUIT
+52 IF OK
DO SETUP^FSCLMPQU(.VALMCNT,CALL)
IF (VALMCNT#10)=0
DO CHECK^FSCLML(.VALMQUIT)
IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
End DoDot:3
IF $DATA(VALMQUIT)
QUIT
+53 DO COUNT^FSCLMPQU(VALMCNT)
+54 KILL ^TMP("FSC MERGE",$JOB)
End DoDot:2
QUIT
+55 IF SELECT="Q"
Begin DoDot:2
+56 DO QUERY^FSCLMPQU("Remove")
End DoDot:2
QUIT
End DoDot:1
+57 IF '$DATA(VALMQUIT)
DO EMPTY^FSCLMPQU
+58 SET VALMBG=1
+59 QUIT
+60 ;
CHECK(CALL,LIST,LIMIT,OK) ;
+1 NEW CNT,DATEO,NUM
+2 IF 'LIMIT
SET OK=0
QUIT
+3 SET OK=1
+4 IF $PIECE(LIMIT,U,2)
Begin DoDot:1
+5 SET CNT=0
SET NUM="A"
FOR
SET NUM=$ORDER(@LIST@(NUM),-1)
if NUM<1
QUIT
SET CNT=CNT+1
IF NUM=CALL
if CNT'>$PIECE(LIMIT,U,2)
SET OK=0
QUIT
End DoDot:1
QUIT
+6 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
+7 IF DATEO'<$PIECE(LIMIT,U,3)
IF DATEO'>$PIECE(LIMIT,U,4)
SET OK=0
+8 QUIT
