Routine: FSCRPCD

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)

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)

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)

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)

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)

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

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)

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)

TEST ;

 D LOADTREE(.IN,.OUT)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCD   5289     printed  Mar 13, 2025@21:24:13                                                                                                                                                                                                     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

FSCRPCD.m