- FSCRPCR ;SLC/STAFF-NOIS RPC Remove ;1/29/98 22:49
- ;;1.1;NOIS;;Sep 06, 1998
- ;
- LISTS(IN,OUT) ; from FSCRPX (RPCRemoveLists)
- 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=1,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=0 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=0 Q
- ..E D
- ...I $D(@RLIST@(CALL)) D
- ....I 'LIMITNUM,'LIMITDTO,'LIMITDFM S OK=0 Q
- ....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=0 Q
- ....I 'LIMITDTO,'LIMITDFM S OK=0 Q
- ....S DATEO=$P(^FSCD("CALL",CALL,0),U,3)
- ....I DATEO'<LIMITDTO,DATEO'>LIMITDFM S OK=0
- .I OK D SETUP^FSCRPCA(CALL,.COUNT)
- D OUTPUT^FSCRPCA
- Q
- ;
- CALLS(IN,OUT) ; from FSCRPX (RPCRemoveCalls)
- N CALL,LNUM,NUM
- S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S CALL=+$G(^(NUM)) D
- .I $D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) S LNUM=+^(CALL) D
- ..K ^TMP("FSC CURRENT LIST",$J,LNUM)
- ..K ^TMP("FSC CURRENT LIST",$J,"C",CALL)
- D OUTPUT^FSCRPCA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCR 1970 printed Dec 13, 2024@02:19:45 Page 2
- FSCRPCR ;SLC/STAFF-NOIS RPC Remove ;1/29/98 22:49
- +1 ;;1.1;NOIS;;Sep 06, 1998
- +2 ;
- LISTS(IN,OUT) ; from FSCRPX (RPCRemoveLists)
- +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=1
- 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=0
- 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=0
- 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=0
- QUIT
- +21 IF LIMITNUM
- Begin DoDot:5
- +22 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=0
- QUIT
- End DoDot:5
- QUIT
- +23 IF 'LIMITDTO
- IF 'LIMITDFM
- SET OK=0
- QUIT
- +24 SET DATEO=$PIECE(^FSCD("CALL",CALL,0),U,3)
- +25 IF DATEO'<LIMITDTO
- IF DATEO'>LIMITDFM
- SET OK=0
- End DoDot:4
- End DoDot:3
- End DoDot:2
- IF 'OK
- QUIT
- +26 IF OK
- DO SETUP^FSCRPCA(CALL,.COUNT)
- End DoDot:1
- +27 DO OUTPUT^FSCRPCA
- +28 QUIT
- +29 ;
- CALLS(IN,OUT) ; from FSCRPX (RPCRemoveCalls)
- +1 NEW CALL,LNUM,NUM
- +2 SET NUM=0
- FOR
- SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
- if NUM<1
- QUIT
- SET CALL=+$GET(^(NUM))
- Begin DoDot:1
- +3 IF $DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
- SET LNUM=+^(CALL)
- Begin DoDot:2
- +4 KILL ^TMP("FSC CURRENT LIST",$JOB,LNUM)
- +5 KILL ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)
- End DoDot:2
- End DoDot:1
- +6 DO OUTPUT^FSCRPCA
- +7 QUIT