FSCRPCA ;SLC/STAFF-NOIS RPC Add ;3/12/99 14:27
;;1.1;NOIS;**1**;Sep 06, 1998
;
ALERT(IN,OUT) ; from FSCRPX (RPCAlert)
N DATA,NODE,TIME,XQAID,XQAKILL
D GETTIME(.TIME) I 'TIME Q
S NODE=$G(^XTV(8992,DUZ,"XQA",TIME,0)),DATA=$G(^(1))
I '$L(NODE) Q
S XQAID=$P(NODE,U,2)
I XQAID["FSC-A" D USER^FSCRPCAP
I XQAID["FSC-M" D ALERT^FSCRPCAP(DATA)
S XQAKILL=1
D DELETE^XQALERT
Q
;
GETTIME(TIME) ;
N NODEID,SUB
S TIME=0
S SUB=0 F S SUB=$O(^XTV(8992,DUZ,"XQA",SUB)) Q:SUB<1 D I TIME>0 Q
.S NODEID=$P($G(^XTV(8992,DUZ,"XQA",SUB,0)),U,2)
.I NODEID["FSC-A" S TIME=SUB Q
.I NODEID["FSC-M" S TIME=SUB Q
Q
;
LISTS(IN,OUT) ; from FSCRPX (RPCAddLists)
N CALL,COUNT,INDX,INPUT,LCNT,LIMIT,LIMITNUM,LIMITDTO,LIMITDFM,LIST,LNAME,LNUM,MAX,OK,RLIST,TIME
S COUNT=0,MAX=$$MAX^FSCRPCL
S LNUM=0 F S LNUM=$O(^TMP("FSCRPC",$J,"INPUT",LNUM)) Q:LNUM<1 S INPUT=^(LNUM) D Q:COUNT'<MAX
.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(LIST,INDX,.RLIST,.OK) I 'OK Q
.S LNAME=$P(^FSC("LIST",LIST,0),U)
.I LNAME="MRE:" D
..S (LIMIT,LCNT)=0,TIME="" F S TIME=$O(^FSCD("MRE","AUTC",INDX,TIME)) Q:TIME="" D Q:LIMIT Q:COUNT'<MAX
...S CALL=0 F S CALL=$O(^FSCD("MRE","AUTC",INDX,TIME,CALL)) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
....I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
.E I LNAME="MRA:" D
..S (LIMIT,LCNT)=0,TIME="" F S TIME=$O(^FSCD("MRA","AUTC",INDX,TIME)) Q:TIME="" D Q:LIMIT Q:COUNT'<MAX
...S CALL=0 F S CALL=$O(^FSCD("MRA","AUTC",INDX,TIME,CALL)) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
....I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
.E D
..S (LIMIT,LCNT)=0,CALL="A" F S CALL=$O(@RLIST@(CALL),-1) Q:CALL<1 D Q:LIMIT Q:COUNT'<MAX
...I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
D OUTPUT
Q
;
CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,LIMIT,LCNT,COUNT) ;
N DATEO
I LIMITNUM D
.I LCNT'<LIMITNUM S LIMIT=1
.E D SETUP(CALL,.COUNT)
E I LIMITDTO!LIMITDFM D
.S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
.I DATEO<LIMITDFM Q
.I DATEO>LIMITDTO Q
.D SETUP(CALL,.COUNT)
E D SETUP(CALL,.COUNT)
S LCNT=LCNT+1
Q
;
SETUP(CALL,COUNT) ; from FSCRPCQ, FSCRPCR, FSCRPCS
N LNUM
S COUNT=COUNT+1
S LNUM=1+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
I LNUM<1000 S LNUM=LNUM+1000
S ^TMP("FSC CURRENT LIST",$J,LNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM
Q
;
LIST(LIST,INDX,RLIST,OK) ; from FSCRPCR, FSCRPCS
N L0,LNAME S OK=1
S L0=$G(^FSC("LIST",LIST,0))
I '$L(L0) S OK=0 Q
S LNAME=$P(L0,U)
I $L($P(L0,U,4)),'$P(L0,U,5) S RLIST="^FSCD(""CALL"","_$P(L0,U,4)_")"
E I $L($P(L0,U,4)),INDX S RLIST="^FSCD(""CALL"","_$P(L0,U,4)_","_INDX_")"
E I $P(L0,U,3)="M" D
.S RLIST="^FSCD(""FSC MLC"","_$J_","_LIST_")"
.D MANUAL^FSCLP(LIST)
.K ^TMP("FSC LIST",$J)
E S RLIST="^FSCD(""LISTS"",""ALC"","_LIST_")"
;D MRU^FSCMR(DUZ,LIST,INDX)
Q
;
CALLS(IN,OUT) ; from FSCRPX (RPCAddCalls)
N CALL,NEWNUM,NUM
S NEWNUM=+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
I NEWNUM<1000 S NEWNUM=NEWNUM+1000
S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S CALL=+^(NUM) D
.I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D
..S NEWNUM=NEWNUM+1
..S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
..S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
D OUTPUT
Q
;
OUTPUT ; from FSCRPCAP, FSCRPCD, FSCRPCQ, FSCRPCR, FSCRPCS
N NUM
S NUM=0 F S NUM=$O(^TMP("FSC CURRENT LIST",$J,NUM)) Q:NUM<1 S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=^(NUM)
Q
;
INSERT(IN,OUT) ; from FSCRPCX (RPCInsertCall)
N CALL,LNUM,NEWNUM
S CALL=+^TMP("FSCRPC",$J,"INPUT",1)
I 'CALL Q
S LNUM=+$O(^TMP("FSC CURRENT LIST",$J,0))
I LNUM<1 S NEWNUM=1000
E S NEWNUM=LNUM-1
F Q:'$D(^TMP("FSC CURRENT LIST",$J,NEWNUM)) S NEWNUM=NEWNUM-1
I NEWNUM<1 Q
S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCA 4161 printed Sep 23, 2025@19:55:29 Page 2
FSCRPCA ;SLC/STAFF-NOIS RPC Add ;3/12/99 14:27
+1 ;;1.1;NOIS;**1**;Sep 06, 1998
+2 ;
ALERT(IN,OUT) ; from FSCRPX (RPCAlert)
+1 NEW DATA,NODE,TIME,XQAID,XQAKILL
+2 DO GETTIME(.TIME)
IF 'TIME
QUIT
+3 SET NODE=$GET(^XTV(8992,DUZ,"XQA",TIME,0))
SET DATA=$GET(^(1))
+4 IF '$LENGTH(NODE)
QUIT
+5 SET XQAID=$PIECE(NODE,U,2)
+6 IF XQAID["FSC-A"
DO USER^FSCRPCAP
+7 IF XQAID["FSC-M"
DO ALERT^FSCRPCAP(DATA)
+8 SET XQAKILL=1
+9 DO DELETE^XQALERT
+10 QUIT
+11 ;
GETTIME(TIME) ;
+1 NEW NODEID,SUB
+2 SET TIME=0
+3 SET SUB=0
FOR
SET SUB=$ORDER(^XTV(8992,DUZ,"XQA",SUB))
if SUB<1
QUIT
Begin DoDot:1
+4 SET NODEID=$PIECE($GET(^XTV(8992,DUZ,"XQA",SUB,0)),U,2)
+5 IF NODEID["FSC-A"
SET TIME=SUB
QUIT
+6 IF NODEID["FSC-M"
SET TIME=SUB
QUIT
End DoDot:1
IF TIME>0
QUIT
+7 QUIT
+8 ;
LISTS(IN,OUT) ; from FSCRPX (RPCAddLists)
+1 NEW CALL,COUNT,INDX,INPUT,LCNT,LIMIT,LIMITNUM,LIMITDTO,LIMITDFM,LIST,LNAME,LNUM,MAX,OK,RLIST,TIME
+2 SET COUNT=0
SET MAX=$$MAX^FSCRPCL
+3 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",LNUM))
if LNUM<1
QUIT
SET INPUT=^(LNUM)
Begin DoDot:1
+4 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)
+5 IF 'LIST
QUIT
+6 DO LIST(LIST,INDX,.RLIST,.OK)
IF 'OK
QUIT
+7 SET LNAME=$PIECE(^FSC("LIST",LIST,0),U)
+8 IF LNAME="MRE:"
Begin DoDot:2
+9 SET (LIMIT,LCNT)=0
SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRE","AUTC",INDX,TIME))
if TIME=""
QUIT
Begin DoDot:3
+10 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRE","AUTC",INDX,TIME,CALL))
if CALL<1
QUIT
Begin DoDot:4
+11 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
DO CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
End DoDot:4
if LIMIT
QUIT
if COUNT'<MAX
QUIT
End DoDot:3
if LIMIT
QUIT
if COUNT'<MAX
QUIT
End DoDot:2
+12 IF '$TEST
IF LNAME="MRA:"
Begin DoDot:2
+13 SET (LIMIT,LCNT)=0
SET TIME=""
FOR
SET TIME=$ORDER(^FSCD("MRA","AUTC",INDX,TIME))
if TIME=""
QUIT
Begin DoDot:3
+14 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("MRA","AUTC",INDX,TIME,CALL))
if CALL<1
QUIT
Begin DoDot:4
+15 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
DO CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
End DoDot:4
if LIMIT
QUIT
if COUNT'<MAX
QUIT
End DoDot:3
if LIMIT
QUIT
if COUNT'<MAX
QUIT
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 SET (LIMIT,LCNT)=0
SET CALL="A"
FOR
SET CALL=$ORDER(@RLIST@(CALL),-1)
if CALL<1
QUIT
Begin DoDot:3
+18 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
DO CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,.LIMIT,.LCNT,.COUNT)
End DoDot:3
if LIMIT
QUIT
if COUNT'<MAX
QUIT
End DoDot:2
End DoDot:1
if COUNT'<MAX
QUIT
+19 DO OUTPUT
+20 QUIT
+21 ;
CHECK(CALL,LIMITNUM,LIMITDTO,LIMITDFM,LIMIT,LCNT,COUNT) ;
+1 NEW DATEO
+2 IF LIMITNUM
Begin DoDot:1
+3 IF LCNT'<LIMITNUM
SET LIMIT=1
+4 IF '$TEST
DO SETUP(CALL,.COUNT)
End DoDot:1
+5 IF '$TEST
IF LIMITDTO!LIMITDFM
Begin DoDot:1
+6 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
+7 IF DATEO<LIMITDFM
QUIT
+8 IF DATEO>LIMITDTO
QUIT
+9 DO SETUP(CALL,.COUNT)
End DoDot:1
+10 IF '$TEST
DO SETUP(CALL,.COUNT)
+11 SET LCNT=LCNT+1
+12 QUIT
+13 ;
SETUP(CALL,COUNT) ; from FSCRPCQ, FSCRPCR, FSCRPCS
+1 NEW LNUM
+2 SET COUNT=COUNT+1
+3 SET LNUM=1+$ORDER(^TMP("FSC CURRENT LIST",$JOB,"A"),-1)
+4 IF LNUM<1000
SET LNUM=LNUM+1000
+5 SET ^TMP("FSC CURRENT LIST",$JOB,LNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+6 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=LNUM
+7 QUIT
+8 ;
LIST(LIST,INDX,RLIST,OK) ; from FSCRPCR, FSCRPCS
+1 NEW L0,LNAME
SET OK=1
+2 SET L0=$GET(^FSC("LIST",LIST,0))
+3 IF '$LENGTH(L0)
SET OK=0
QUIT
+4 SET LNAME=$PIECE(L0,U)
+5 IF $LENGTH($PIECE(L0,U,4))
IF '$PIECE(L0,U,5)
SET RLIST="^FSCD(""CALL"","_$PIECE(L0,U,4)_")"
+6 IF '$TEST
IF $LENGTH($PIECE(L0,U,4))
IF INDX
SET RLIST="^FSCD(""CALL"","_$PIECE(L0,U,4)_","_INDX_")"
+7 IF '$TEST
IF $PIECE(L0,U,3)="M"
Begin DoDot:1
+8 SET RLIST="^FSCD(""FSC MLC"","_$JOB_","_LIST_")"
+9 DO MANUAL^FSCLP(LIST)
+10 KILL ^TMP("FSC LIST",$JOB)
End DoDot:1
+11 IF '$TEST
SET RLIST="^FSCD(""LISTS"",""ALC"","_LIST_")"
+12 ;D MRU^FSCMR(DUZ,LIST,INDX)
+13 QUIT
+14 ;
CALLS(IN,OUT) ; from FSCRPX (RPCAddCalls)
+1 NEW CALL,NEWNUM,NUM
+2 SET NEWNUM=+$ORDER(^TMP("FSC CURRENT LIST",$JOB,"A"),-1)
+3 IF NEWNUM<1000
SET NEWNUM=NEWNUM+1000
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET CALL=+^(NUM)
Begin DoDot:1
+5 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
Begin DoDot:2
+6 SET NEWNUM=NEWNUM+1
+7 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+8 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=NEWNUM
End DoDot:2
End DoDot:1
+9 DO OUTPUT
+10 QUIT
+11 ;
OUTPUT ; from FSCRPCAP, FSCRPCD, FSCRPCQ, FSCRPCR, FSCRPCS
+1 NEW NUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,NUM))
if NUM<1
QUIT
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=^(NUM)
+3 QUIT
+4 ;
INSERT(IN,OUT) ; from FSCRPCX (RPCInsertCall)
+1 NEW CALL,LNUM,NEWNUM
+2 SET CALL=+^TMP("FSCRPC",$JOB,"INPUT",1)
+3 IF 'CALL
QUIT
+4 SET LNUM=+$ORDER(^TMP("FSC CURRENT LIST",$JOB,0))
+5 IF LNUM<1
SET NEWNUM=1000
+6 IF '$TEST
SET NEWNUM=LNUM-1
+7 FOR
if '$DATA(^TMP("FSC CURRENT LIST",$JOB,NEWNUM))
QUIT
SET NEWNUM=NEWNUM-1
+8 IF NEWNUM<1
QUIT
+9 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+10 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=NEWNUM
+11 QUIT
