FSCQR ;SLC/STAFF-NOIS Query Routing ;1/11/98 18:46
;;1.1;NOIS;;Sep 06, 1998
;
QUERY(LIST,LISTCNT,CRITERIA) ; from FSCLP, FSCQB, FSCRPCQ
; ***make lists globals
N NEWCALL,NEWSTEP,OP,SEQNUM
S OP=$P(CRITERIA(0),U)
I OP="Add" D Q
.I $P(CRITERIA(0),U,2)>1,$P(CRITERIA(0),U,2)<4 D Q ;*** test when multiple passes better than all calls
..S $P(CRITERIA(0),U,2)=1
..S NEWSTEP=0 F S NEWSTEP=$O(CRITERIA(NEWSTEP)) Q:NEWSTEP<1 D
...K ^TMP("FSC USELIST",$J)
...D SEARCH^FSCQS(0,.CRITERIA)
...S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC NEWLIST",$J,NEWCALL)) Q:NEWCALL<1 S ^TMP("FSC LIST",$J,NEWCALL,0)=NEWCALL
...S LISTCNT=$$COUNT
...K CRITERIA(NEWSTEP)
...S SEQNUM=0 F S SEQNUM=$O(CRITERIA("O",SEQNUM)) Q:SEQNUM<1 I CRITERIA("O",SEQNUM)=NEWSTEP K CRITERIA("O",SEQNUM) Q
.K ^TMP("FSC USELIST",$J)
.D SEARCH^FSCQS(0,.CRITERIA)
.S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC NEWLIST",$J,NEWCALL)) Q:NEWCALL<1 S ^TMP("FSC LIST",$J,NEWCALL,0)=NEWCALL
.S LISTCNT=$$COUNT
I OP="Remove" D Q
.I LISTCNT=0 Q
.K ^TMP("FSC USELIST",$J) S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC LIST",$J,NEWCALL)) Q:NEWCALL<1 S ^TMP("FSC USELIST",$J,NEWCALL)=""
.D SEARCH^FSCQS(LISTCNT,.CRITERIA)
.S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC NEWLIST",$J,NEWCALL)) Q:NEWCALL<1 K ^TMP("FSC LIST",$J,NEWCALL)
.S LISTCNT=$$COUNT
; select
I LISTCNT=0 Q
K ^TMP("FSC USELIST",$J),LIST S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC LIST",$J,NEWCALL)) Q:NEWCALL<1 S ^TMP("FSC USELIST",$J,NEWCALL)=""
D SEARCH^FSCQS(LISTCNT,.CRITERIA)
K ^TMP("FSC LIST",$J),LIST
S NEWCALL=0 F S NEWCALL=$O(^TMP("FSC NEWLIST",$J,NEWCALL)) Q:NEWCALL<1 S ^TMP("FSC LIST",$J,NEWCALL,0)=NEWCALL
S LISTCNT=$$COUNT
Q
;
COUNT() ; $$() -> number of calls in list
N CALL,CNT S (CALL,CNT)=0 F S CALL=$O(^TMP("FSC LIST",$J,CALL)) Q:CALL<1 S CNT=CNT+1
Q CNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCQR 1839 printed Apr 09, 2024@21:23:02 Page 2
FSCQR ;SLC/STAFF-NOIS Query Routing ;1/11/98 18:46
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
QUERY(LIST,LISTCNT,CRITERIA) ; from FSCLP, FSCQB, FSCRPCQ
+1 ; ***make lists globals
+2 NEW NEWCALL,NEWSTEP,OP,SEQNUM
+3 SET OP=$PIECE(CRITERIA(0),U)
+4 IF OP="Add"
Begin DoDot:1
+5 ;*** test when multiple passes better than all calls
IF $PIECE(CRITERIA(0),U,2)>1
IF $PIECE(CRITERIA(0),U,2)<4
Begin DoDot:2
+6 SET $PIECE(CRITERIA(0),U,2)=1
+7 SET NEWSTEP=0
FOR
SET NEWSTEP=$ORDER(CRITERIA(NEWSTEP))
if NEWSTEP<1
QUIT
Begin DoDot:3
+8 KILL ^TMP("FSC USELIST",$JOB)
+9 DO SEARCH^FSCQS(0,.CRITERIA)
+10 SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC NEWLIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
SET ^TMP("FSC LIST",$JOB,NEWCALL,0)=NEWCALL
+11 SET LISTCNT=$$COUNT
+12 KILL CRITERIA(NEWSTEP)
+13 SET SEQNUM=0
FOR
SET SEQNUM=$ORDER(CRITERIA("O",SEQNUM))
if SEQNUM<1
QUIT
IF CRITERIA("O",SEQNUM)=NEWSTEP
KILL CRITERIA("O",SEQNUM)
QUIT
End DoDot:3
End DoDot:2
QUIT
+14 KILL ^TMP("FSC USELIST",$JOB)
+15 DO SEARCH^FSCQS(0,.CRITERIA)
+16 SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC NEWLIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
SET ^TMP("FSC LIST",$JOB,NEWCALL,0)=NEWCALL
+17 SET LISTCNT=$$COUNT
End DoDot:1
QUIT
+18 IF OP="Remove"
Begin DoDot:1
+19 IF LISTCNT=0
QUIT
+20 KILL ^TMP("FSC USELIST",$JOB)
SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC LIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
SET ^TMP("FSC USELIST",$JOB,NEWCALL)=""
+21 DO SEARCH^FSCQS(LISTCNT,.CRITERIA)
+22 SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC NEWLIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
KILL ^TMP("FSC LIST",$JOB,NEWCALL)
+23 SET LISTCNT=$$COUNT
End DoDot:1
QUIT
+24 ; select
+25 IF LISTCNT=0
QUIT
+26 KILL ^TMP("FSC USELIST",$JOB),LIST
SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC LIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
SET ^TMP("FSC USELIST",$JOB,NEWCALL)=""
+27 DO SEARCH^FSCQS(LISTCNT,.CRITERIA)
+28 KILL ^TMP("FSC LIST",$JOB),LIST
+29 SET NEWCALL=0
FOR
SET NEWCALL=$ORDER(^TMP("FSC NEWLIST",$JOB,NEWCALL))
if NEWCALL<1
QUIT
SET ^TMP("FSC LIST",$JOB,NEWCALL,0)=NEWCALL
+30 SET LISTCNT=$$COUNT
+31 QUIT
+32 ;
COUNT() ; $$() -> number of calls in list
+1 NEW CALL,CNT
SET (CALL,CNT)=0
FOR
SET CALL=$ORDER(^TMP("FSC LIST",$JOB,CALL))
if CALL<1
QUIT
SET CNT=CNT+1
+2 QUIT CNT
