FSCRPCS ;SLC/STAFF-NOIS RPC Select ;1/29/98 22:50
;;1.1;NOIS;;Sep 06, 1998
;
LISTS(IN,OUT) ; from FSCRPX (RPCSelectLists)
N CALL,CALLX,CNT,COUNT,DATEO,INDX,INPUT,LIMITDFM,LIMITDTO,LIMITNUM,LIST,LISTNUM,LNAME,LNUM,NUM,OK,RLIST,ROK,TIME
K ^TMP("FSC MERGE",$J) S COUNT=0
S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
.S ^TMP("FSC MERGE",$J,LNUM,CALL)=""
K ^TMP("FSC CURRENT LIST",$J)
S LNUM=0 F S LNUM=$O(^TMP("FSC MERGE",$J,LNUM)) Q:LNUM<1 S CALL=$O(^(LNUM,0)) D
.S OK=0,LISTNUM=0 F S LISTNUM=$O(^TMP("FSCRPC",$J,"INPUT",LISTNUM)) Q:LISTNUM<1 S INPUT=^(LISTNUM) D I OK Q
..S LIST=+INPUT,INDX=+$P(INPUT,U,2),LIMITNUM=$P(INPUT,U,3),LIMITDTO=$P(INPUT,U,4),LIMITDFM=$P(INPUT,U,5)
..I 'LIST Q
..D LIST^FSCRPCA(LIST,INDX,.RLIST,.ROK) I 'ROK Q
..S LNAME=$P(^FSC("LIST",LIST,0),U)
..I LNAME="MRE:" D
...S TIME="" F S TIME=$O(^FSCD("MRE","AUTC",INDX,TIME)) Q:TIME="" D I OK Q
....S CALLX=0 F S CALLX=$O(^FSCD("MRE","AUTC",INDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=1 Q
..E I LNAME="MRA:" D
...S TIME="" F S TIME=$O(^FSCD("MRA","AUTC",INDX,TIME)) Q:TIME="" D I OK Q
....S CALLX=0 F S CALLX=$O(^FSCD("MRA","AUTC",INDX,TIME,CALLX)) Q:CALLX<1 I CALLX=CALL S OK=1 Q
..E D
...I $D(@RLIST@(CALL)) D
....I 'LIMITNUM,'LIMITDTO,'LIMITDFM S OK=1 Q
....S OK=0
....I LIMITNUM D Q
.....S CNT=0,NUM="A" F S NUM=$O(@RLIST@(NUM),-1) Q:NUM<1 S CNT=CNT+1 I NUM=CALL S:CNT'>LIMITNUM OK=1 Q
....I 'LIMITDTO,'LIMITDFM S OK=1 Q
....S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
....I DATEO'<LIMITDTO,DATEO'>LIMITDFM S OK=1
.I OK D SETUP^FSCRPCA(CALL,.COUNT)
D OUTPUT^FSCRPCA
Q
;
CALLS(IN,OUT) ; from FSCRPX (RPCSelectCalls)
N CALL,LNUM,NUM
K ^TMP("FSC CURRENT LIST",$J)
S LNUM=0
S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S CALL=+$G(^(NUM)) D
.S LNUM=LNUM+1
.S (^TMP("FSCRPC",$J,"OUTPUT",LNUM),^TMP("FSC CURRENT LIST",$J,LNUM+1000))=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
.S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM+1000
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCS 2038 printed Apr 09, 2024@21:21:11 Page 2
FSCRPCS ;SLC/STAFF-NOIS RPC Select ;1/29/98 22:50
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
LISTS(IN,OUT) ; from FSCRPX (RPCSelectLists)
+1 NEW CALL,CALLX,CNT,COUNT,DATEO,INDX,INPUT,LIMITDFM,LIMITDTO,LIMITNUM,LIST,LISTNUM,LNAME,LNUM,NUM,OK,RLIST,ROK,TIME
+2 KILL ^TMP("FSC MERGE",$JOB)
SET COUNT=0
+3 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
Begin DoDot:1
+4 SET ^TMP("FSC MERGE",$JOB,LNUM,CALL)=""
End DoDot:1
+5 KILL ^TMP("FSC CURRENT LIST",$JOB)
+6 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC MERGE",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=$ORDER(^(LNUM,0))
Begin DoDot:1
+7 SET OK=0
SET LISTNUM=0
FOR
SET LISTNUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",LISTNUM))
if LISTNUM<1
QUIT
SET INPUT=^(LISTNUM)
Begin DoDot:2
+8 SET LIST=+INPUT
SET INDX=+$PIECE(INPUT,U,2)
SET LIMITNUM=$PIECE(INPUT,U,3)
SET LIMITDTO=$PIECE(INPUT,U,4)
SET LIMITDFM=$PIECE(INPUT,U,5)
+9 IF 'LIST
QUIT
+10 DO LIST^FSCRPCA(LIST,INDX,.RLIST,.ROK)
IF 'ROK
QUIT
+11 SET LNAME=$PIECE(^FSC("LIST",LIST,0),U)
+12 IF LNAME="MRE:"
Begin DoDot:3
+13 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRE","AUTC",INDX,TIME))
if TIME=""
QUIT
Begin DoDot:4
+14 SET CALLX=0
FOR
SET CALLX=$ORDER(^FSCD("MRE","AUTC",INDX,TIME,CALLX))
if CALLX<1
QUIT
IF CALLX=CALL
SET OK=1
QUIT
End DoDot:4
IF OK
QUIT
End DoDot:3
+15 IF '$TEST
IF LNAME="MRA:"
Begin DoDot:3
+16 SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRA","AUTC",INDX,TIME))
if TIME=""
QUIT
Begin DoDot:4
+17 SET CALLX=0
FOR
SET CALLX=$ORDER(^FSCD("MRA","AUTC",INDX,TIME,CALLX))
if CALLX<1
QUIT
IF CALLX=CALL
SET OK=1
QUIT
End DoDot:4
IF OK
QUIT
End DoDot:3
+18 IF '$TEST
Begin DoDot:3
+19 IF $DATA(@RLIST@(CALL))
Begin DoDot:4
+20 IF 'LIMITNUM
IF 'LIMITDTO
IF 'LIMITDFM
SET OK=1
QUIT
+21 SET OK=0
+22 IF LIMITNUM
Begin DoDot:5
+23 SET CNT=0
SET NUM="A"
FOR
SET NUM=$ORDER(@RLIST@(NUM),-1)
if NUM<1
QUIT
SET CNT=CNT+1
IF NUM=CALL
if CNT'>LIMITNUM
SET OK=1
QUIT
End DoDot:5
QUIT
+24 IF 'LIMITDTO
IF 'LIMITDFM
SET OK=1
QUIT
+25 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
+26 IF DATEO'<LIMITDTO
IF DATEO'>LIMITDFM
SET OK=1
End DoDot:4
End DoDot:3
End DoDot:2
IF OK
QUIT
+27 IF OK
DO SETUP^FSCRPCA(CALL,.COUNT)
End DoDot:1
+28 DO OUTPUT^FSCRPCA
+29 QUIT
+30 ;
CALLS(IN,OUT) ; from FSCRPX (RPCSelectCalls)
+1 NEW CALL,LNUM,NUM
+2 KILL ^TMP("FSC CURRENT LIST",$JOB)
+3 SET LNUM=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET CALL=+$GET(^(NUM))
Begin DoDot:1
+5 SET LNUM=LNUM+1
+6 SET (^TMP("FSCRPC",$JOB,"OUTPUT",LNUM),^TMP("FSC CURRENT LIST",$JOB,LNUM+1000))=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+7 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=LNUM+1000
End DoDot:1
+8 QUIT
