FSCRPCD ;SLC/STAFF-NOIS RPC Duplicates ;4/28/98 12:15
;;1.1;NOIS;;Sep 06, 1998
;
ASSOC(IN,OUT) ; from FSCRPX (RPCAssociate)
N CALL1,CALL2
S CALL1=+$G(^TMP("FSCRPC",$J,"INPUT",1)),CALL2=+$P($G(^(1)),U,2)
D ASSOC^FSCLMPEA(CALL1,CALL2)
Q
;
EXPAND(IN,OUT) ; from FSCRPX (RPCExpand)
N CALL,NEWNUM,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
M ^TMP("FSC MERGE",$J)=^TMP("FSC CURRENT LIST",$J,"C")
K ^TMP("FSC CURRENT LIST",$J)
S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
.S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
.S ^TMP("FSC MERGE",$J,"CX",PRIMARY)=""
S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
.S ^TMP("FSC MERGE",$J,CALL)=""
S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
.S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",CALL,SECOND)) Q:SECOND<1 D
..S ^TMP("FSC MERGE",$J,SECOND)=""
S NEWNUM=0
S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q: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^FSCRPCA
K ^TMP("FSC MERGE",$J)
Q
;
COLLAPSE(IN,OUT) ; from FSCRPX (RPCCollapse)
N CALL,NEWNUM,PRIMARY K ^TMP("FSC MERGE",$J)
M ^TMP("FSC MERGE",$J,"C")=^TMP("FSC CURRENT LIST",$J,"C")
K ^TMP("FSC CURRENT LIST",$J)
S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"C",CALL)) Q:CALL<1 D
.S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
.S ^TMP("FSC MERGE",$J,PRIMARY)=""
S NEWNUM=0
S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q: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^FSCRPCA
K ^TMP("FSC MERGE",$J)
Q
;
EXPCALL(IN,OUT) ; from FSCRPX (RPCExpandCall)
N CALL,CNT,GETCALL,NEWNUM,PRIMARY K ^TMP("FSC MERGE",$J)
S GETCALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'GETCALL Q
S PRIMARY=+$P($G(^FSCD("CALL",GETCALL,120)),U,24)
I 'PRIMARY Q
I GETCALL=PRIMARY,'$O(^FSCD("CALL","APRIMARY",PRIMARY,0)) Q
S NEWNUM=+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
I NEWNUM<1000 S NEWNUM=NEWNUM+1000
I '$D(^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)) D
.S NEWNUM=NEWNUM+1
.S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
.S ^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)=NEWNUM
.S ^TMP("FSC MERGE",$J,PRIMARY)=""
S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",PRIMARY,CALL)) Q:CALL<1 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
..S ^TMP("FSC MERGE",$J,CALL)=""
S CNT=0
S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
K ^TMP("FSC MERGE",$J)
Q
;
DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
N CALL,CNT,GETCALL,PRIMARY
S GETCALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'GETCALL Q
S PRIMARY=+$P($G(^FSCD("CALL",GETCALL,120)),U,24)
I 'PRIMARY Q
K ^TMP("FSC CURRENT LIST",$J)
S CNT=1
S ^TMP("FSC CURRENT LIST",$J,CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
S ^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)=CNT
S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",PRIMARY,CALL)) Q:CALL<1 D
.S CNT=CNT+1
.S ^TMP("FSC CURRENT LIST",$J,CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
.S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=CNT
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
Q
;
DUPHIST(IN,OUT) ; from FSCRPX (RPCDuplicateHistory)
N CALL,CALLID,CNT,LINE,NUM
S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
S CALLID=$P($G(^FSCD("CALL",CALL,0)),U) I '$L(CALLID) Q
S CNT=1
S ^TMP("FSCRPC",$J,"OUTPUT",CNT)="Primary call: "_CALLID
S NUM=0 F S NUM=$O(^FSCD("CALL",CALL,103,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
Q
;
LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
N CALL,CNT,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
S CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 D
.S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
.S ^TMP("FSC MERGE",$J,PRIMARY,.5)=PRIMARY_U_PRIMARY_U_$$TEXTID(PRIMARY)
.S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",PRIMARY,SECOND)) Q:SECOND<1 D
..I $D(^TMP("FSC MERGE",$J,PRIMARY,SECOND)) Q
..S ^TMP("FSC MERGE",$J,PRIMARY,SECOND)=PRIMARY_U_SECOND_U_$$TEXTID(SECOND)
S CNT=0,PRIMARY="A" F S PRIMARY=$O(^TMP("FSC MERGE",$J,PRIMARY),-1) Q:PRIMARY="" D
.S SECOND=0 F S SECOND=$O(^TMP("FSC MERGE",$J,PRIMARY,SECOND)) Q:SECOND<.5 D
..S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=^TMP("FSC MERGE",$J,PRIMARY,SECOND)
K ^TMP("FSC MERGE",$J)
Q
;
TEXTID(CALL) ; $$(call) -> text for tree display
Q $P(^FSCD("CALL",CALL,0),U)_" "_$G(^FSCD("CALL",CALL,1))
;
SAVETREE(IN,OUT) ; from FSCRPX (RPCSaveTree)
N CALL1,CALL2,LINE,NUM
S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
.S CALL1=$P(LINE,U),CALL2=$P(LINE,U,2)
.I $P($G(^FSCD("CALL",CALL2,120)),U,24)=CALL1 Q
.D SETUP^FSCLMPEA(CALL2,CALL1)
Q
;
TEST ;
D LOADTREE(.IN,.OUT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCD 5289 printed Apr 09, 2024@21:20:47 Page 2
FSCRPCD ;SLC/STAFF-NOIS RPC Duplicates ;4/28/98 12:15
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
ASSOC(IN,OUT) ; from FSCRPX (RPCAssociate)
+1 NEW CALL1,CALL2
+2 SET CALL1=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET CALL2=+$PIECE($GET(^(1)),U,2)
+3 DO ASSOC^FSCLMPEA(CALL1,CALL2)
+4 QUIT
+5 ;
EXPAND(IN,OUT) ; from FSCRPX (RPCExpand)
+1 NEW CALL,NEWNUM,PRIMARY,SECOND
KILL ^TMP("FSC MERGE",$JOB)
+2 MERGE ^TMP("FSC MERGE",$JOB)=^TMP("FSC CURRENT LIST",$JOB,"C")
+3 KILL ^TMP("FSC CURRENT LIST",$JOB)
+4 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL))
if CALL<1
QUIT
Begin DoDot:1
+5 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALL,120)),U,24)
IF 'PRIMARY
QUIT
+6 SET ^TMP("FSC MERGE",$JOB,"CX",PRIMARY)=""
End DoDot:1
+7 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
if CALL<1
QUIT
Begin DoDot:1
+8 SET ^TMP("FSC MERGE",$JOB,CALL)=""
End DoDot:1
+9 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"CX",CALL))
if CALL<1
QUIT
Begin DoDot:1
+10 SET SECOND=0
FOR
SET SECOND=$ORDER(^FSCD("CALL","APRIMARY",CALL,SECOND))
if SECOND<1
QUIT
Begin DoDot:2
+11 SET ^TMP("FSC MERGE",$JOB,SECOND)=""
End DoDot:2
End DoDot:1
+12 SET NEWNUM=0
+13 SET CALL="A"
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL),-1)
if CALL=""
QUIT
Begin DoDot:1
+14 SET NEWNUM=NEWNUM+1
+15 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+16 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=NEWNUM
End DoDot:1
+17 DO OUTPUT^FSCRPCA
+18 KILL ^TMP("FSC MERGE",$JOB)
+19 QUIT
+20 ;
COLLAPSE(IN,OUT) ; from FSCRPX (RPCCollapse)
+1 NEW CALL,NEWNUM,PRIMARY
KILL ^TMP("FSC MERGE",$JOB)
+2 MERGE ^TMP("FSC MERGE",$JOB,"C")=^TMP("FSC CURRENT LIST",$JOB,"C")
+3 KILL ^TMP("FSC CURRENT LIST",$JOB)
+4 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,"C",CALL))
if CALL<1
QUIT
Begin DoDot:1
+5 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALL,120)),U,24)
IF 'PRIMARY
QUIT
+6 SET ^TMP("FSC MERGE",$JOB,PRIMARY)=""
End DoDot:1
+7 SET NEWNUM=0
+8 SET CALL="A"
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL),-1)
if CALL=""
QUIT
Begin DoDot:1
+9 SET NEWNUM=NEWNUM+1
+10 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+11 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=NEWNUM
End DoDot:1
+12 DO OUTPUT^FSCRPCA
+13 KILL ^TMP("FSC MERGE",$JOB)
+14 QUIT
+15 ;
EXPCALL(IN,OUT) ; from FSCRPX (RPCExpandCall)
+1 NEW CALL,CNT,GETCALL,NEWNUM,PRIMARY
KILL ^TMP("FSC MERGE",$JOB)
+2 SET GETCALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'GETCALL
QUIT
+4 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",GETCALL,120)),U,24)
+5 IF 'PRIMARY
QUIT
+6 IF GETCALL=PRIMARY
IF '$ORDER(^FSCD("CALL","APRIMARY",PRIMARY,0))
QUIT
+7 SET NEWNUM=+$ORDER(^TMP("FSC CURRENT LIST",$JOB,"A"),-1)
+8 IF NEWNUM<1000
SET NEWNUM=NEWNUM+1000
+9 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",PRIMARY))
Begin DoDot:1
+10 SET NEWNUM=NEWNUM+1
+11 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
+12 SET ^TMP("FSC CURRENT LIST",$JOB,"C",PRIMARY)=NEWNUM
+13 SET ^TMP("FSC MERGE",$JOB,PRIMARY)=""
End DoDot:1
+14 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","APRIMARY",PRIMARY,CALL))
if CALL<1
QUIT
Begin DoDot:1
+15 IF '$DATA(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
Begin DoDot:2
+16 SET NEWNUM=NEWNUM+1
+17 SET ^TMP("FSC CURRENT LIST",$JOB,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+18 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=NEWNUM
+19 SET ^TMP("FSC MERGE",$JOB,CALL)=""
End DoDot:2
End DoDot:1
+20 SET CNT=0
+21 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC MERGE",$JOB,CALL))
if CALL<1
QUIT
Begin DoDot:1
+22 SET CNT=CNT+1
+23 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
End DoDot:1
+24 KILL ^TMP("FSC MERGE",$JOB)
+25 QUIT
+26 ;
DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
+1 NEW CALL,CNT,GETCALL,PRIMARY
+2 SET GETCALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'GETCALL
QUIT
+4 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",GETCALL,120)),U,24)
+5 IF 'PRIMARY
QUIT
+6 KILL ^TMP("FSC CURRENT LIST",$JOB)
+7 SET CNT=1
+8 SET ^TMP("FSC CURRENT LIST",$JOB,CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
+9 SET ^TMP("FSC CURRENT LIST",$JOB,"C",PRIMARY)=CNT
+10 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
+11 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("CALL","APRIMARY",PRIMARY,CALL))
if CALL<1
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 SET ^TMP("FSC CURRENT LIST",$JOB,CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+14 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=CNT
+15 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
End DoDot:1
+16 QUIT
+17 ;
DUPHIST(IN,OUT) ; from FSCRPX (RPCDuplicateHistory)
+1 NEW CALL,CALLID,CNT,LINE,NUM
+2 SET CALL=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 SET CALLID=$PIECE($GET(^FSCD("CALL",CALL,0)),U)
IF '$LENGTH(CALLID)
QUIT
+4 SET CNT=1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)="Primary call: "_CALLID
+6 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("CALL",CALL,103,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
Begin DoDot:1
+7 SET CNT=CNT+1
+8 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
+9 QUIT
+10 ;
LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
+1 NEW CALL,CNT,PRIMARY,SECOND
KILL ^TMP("FSC MERGE",$JOB)
+2 SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
if CALL<1
QUIT
Begin DoDot:1
+3 SET PRIMARY=+$PIECE($GET(^FSCD("CALL",CALL,120)),U,24)
IF 'PRIMARY
QUIT
+4 SET ^TMP("FSC MERGE",$JOB,PRIMARY,.5)=PRIMARY_U_PRIMARY_U_$$TEXTID(PRIMARY)
+5 SET SECOND=0
FOR
SET SECOND=$ORDER(^FSCD("CALL","APRIMARY",PRIMARY,SECOND))
if SECOND<1
QUIT
Begin DoDot:2
+6 IF $DATA(^TMP("FSC MERGE",$JOB,PRIMARY,SECOND))
QUIT
+7 SET ^TMP("FSC MERGE",$JOB,PRIMARY,SECOND)=PRIMARY_U_SECOND_U_$$TEXTID(SECOND)
End DoDot:2
End DoDot:1
+8 SET CNT=0
SET PRIMARY="A"
FOR
SET PRIMARY=$ORDER(^TMP("FSC MERGE",$JOB,PRIMARY),-1)
if PRIMARY=""
QUIT
Begin DoDot:1
+9 SET SECOND=0
FOR
SET SECOND=$ORDER(^TMP("FSC MERGE",$JOB,PRIMARY,SECOND))
if SECOND<.5
QUIT
Begin DoDot:2
+10 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=^TMP("FSC MERGE",$JOB,PRIMARY,SECOND)
End DoDot:2
End DoDot:1
+11 KILL ^TMP("FSC MERGE",$JOB)
+12 QUIT
+13 ;
TEXTID(CALL) ; $$(call) -> text for tree display
+1 QUIT $PIECE(^FSCD("CALL",CALL,0),U)_" "_$GET(^FSCD("CALL",CALL,1))
+2 ;
SAVETREE(IN,OUT) ; from FSCRPX (RPCSaveTree)
+1 NEW CALL1,CALL2,LINE,NUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+3 SET CALL1=$PIECE(LINE,U)
SET CALL2=$PIECE(LINE,U,2)
+4 IF $PIECE($GET(^FSCD("CALL",CALL2,120)),U,24)=CALL1
QUIT
+5 DO SETUP^FSCLMPEA(CALL2,CALL1)
End DoDot:1
+6 QUIT
+7 ;
TEST ;
+1 DO LOADTREE(.IN,.OUT)
+2 QUIT
