source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCD.m@ 949

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