source: FOIAVistA/tag/r/NOIS-FSC/FSCRPCD.m@ 1499

Last change on this file since 1499 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1FSCRPCD ;SLC/STAFF-NOIS RPC Duplicates ;4/28/98 12:15
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4ASSOC(IN,OUT) ; from FSCRPX (RPCAssociate)
5 N CALL1,CALL2
6 S CALL1=+$G(^TMP("FSCRPC",$J,"INPUT",1)),CALL2=+$P($G(^(1)),U,2)
7 D ASSOC^FSCLMPEA(CALL1,CALL2)
8 Q
9 ;
10EXPAND(IN,OUT) ; from FSCRPX (RPCExpand)
11 N CALL,NEWNUM,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
12 M ^TMP("FSC MERGE",$J)=^TMP("FSC CURRENT LIST",$J,"C")
13 K ^TMP("FSC CURRENT LIST",$J)
14 S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
15 .S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
16 .S ^TMP("FSC MERGE",$J,"CX",PRIMARY)=""
17 S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
18 .S ^TMP("FSC MERGE",$J,CALL)=""
19 S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"CX",CALL)) Q:CALL<1 D
20 .S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",CALL,SECOND)) Q:SECOND<1 D
21 ..S ^TMP("FSC MERGE",$J,SECOND)=""
22 S NEWNUM=0
23 S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q:CALL="" D
24 .S NEWNUM=NEWNUM+1
25 .S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
26 .S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
27 D OUTPUT^FSCRPCA
28 K ^TMP("FSC MERGE",$J)
29 Q
30 ;
31COLLAPSE(IN,OUT) ; from FSCRPX (RPCCollapse)
32 N CALL,NEWNUM,PRIMARY K ^TMP("FSC MERGE",$J)
33 M ^TMP("FSC MERGE",$J,"C")=^TMP("FSC CURRENT LIST",$J,"C")
34 K ^TMP("FSC CURRENT LIST",$J)
35 S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,"C",CALL)) Q:CALL<1 D
36 .S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
37 .S ^TMP("FSC MERGE",$J,PRIMARY)=""
38 S NEWNUM=0
39 S CALL="A" F S CALL=$O(^TMP("FSC MERGE",$J,CALL),-1) Q:CALL="" D
40 .S NEWNUM=NEWNUM+1
41 .S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
42 .S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
43 D OUTPUT^FSCRPCA
44 K ^TMP("FSC MERGE",$J)
45 Q
46 ;
47EXPCALL(IN,OUT) ; from FSCRPX (RPCExpandCall)
48 N CALL,CNT,GETCALL,NEWNUM,PRIMARY K ^TMP("FSC MERGE",$J)
49 S GETCALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
50 I 'GETCALL Q
51 S PRIMARY=+$P($G(^FSCD("CALL",GETCALL,120)),U,24)
52 I 'PRIMARY Q
53 I GETCALL=PRIMARY,'$O(^FSCD("CALL","APRIMARY",PRIMARY,0)) Q
54 S NEWNUM=+$O(^TMP("FSC CURRENT LIST",$J,"A"),-1)
55 I NEWNUM<1000 S NEWNUM=NEWNUM+1000
56 I '$D(^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)) D
57 .S NEWNUM=NEWNUM+1
58 .S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
59 .S ^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)=NEWNUM
60 .S ^TMP("FSC MERGE",$J,PRIMARY)=""
61 S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",PRIMARY,CALL)) Q:CALL<1 D
62 .I '$D(^TMP("FSC CURRENT LIST",$J,"C",CALL)) D
63 ..S NEWNUM=NEWNUM+1
64 ..S ^TMP("FSC CURRENT LIST",$J,NEWNUM)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
65 ..S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=NEWNUM
66 ..S ^TMP("FSC MERGE",$J,CALL)=""
67 S CNT=0
68 S CALL=0 F S CALL=$O(^TMP("FSC MERGE",$J,CALL)) Q:CALL<1 D
69 .S CNT=CNT+1
70 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
71 K ^TMP("FSC MERGE",$J)
72 Q
73 ;
74DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
75 N CALL,CNT,GETCALL,PRIMARY
76 S GETCALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
77 I 'GETCALL Q
78 S PRIMARY=+$P($G(^FSCD("CALL",GETCALL,120)),U,24)
79 I 'PRIMARY Q
80 K ^TMP("FSC CURRENT LIST",$J)
81 S CNT=1
82 S ^TMP("FSC CURRENT LIST",$J,CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
83 S ^TMP("FSC CURRENT LIST",$J,"C",PRIMARY)=CNT
84 S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=PRIMARY_U_$$SHORT^FSCRPXUS(PRIMARY,DUZ)
85 S CALL=0 F S CALL=$O(^FSCD("CALL","APRIMARY",PRIMARY,CALL)) Q:CALL<1 D
86 .S CNT=CNT+1
87 .S ^TMP("FSC CURRENT LIST",$J,CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
88 .S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=CNT
89 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
90 Q
91 ;
92DUPHIST(IN,OUT) ; from FSCRPX (RPCDuplicateHistory)
93 N CALL,CALLID,CNT,LINE,NUM
94 S CALL=+$G(^TMP("FSCRPC",$J,"INPUT",1))
95 S CALLID=$P($G(^FSCD("CALL",CALL,0)),U) I '$L(CALLID) Q
96 S CNT=1
97 S ^TMP("FSCRPC",$J,"OUTPUT",CNT)="Primary call: "_CALLID
98 S NUM=0 F S NUM=$O(^FSCD("CALL",CALL,103,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) D
99 .S CNT=CNT+1
100 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
101 Q
102 ;
103LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
104 N CALL,CNT,PRIMARY,SECOND K ^TMP("FSC MERGE",$J)
105 S CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 D
106 .S PRIMARY=+$P($G(^FSCD("CALL",CALL,120)),U,24) I 'PRIMARY Q
107 .S ^TMP("FSC MERGE",$J,PRIMARY,.5)=PRIMARY_U_PRIMARY_U_$$TEXTID(PRIMARY)
108 .S SECOND=0 F S SECOND=$O(^FSCD("CALL","APRIMARY",PRIMARY,SECOND)) Q:SECOND<1 D
109 ..I $D(^TMP("FSC MERGE",$J,PRIMARY,SECOND)) Q
110 ..S ^TMP("FSC MERGE",$J,PRIMARY,SECOND)=PRIMARY_U_SECOND_U_$$TEXTID(SECOND)
111 S CNT=0,PRIMARY="A" F S PRIMARY=$O(^TMP("FSC MERGE",$J,PRIMARY),-1) Q:PRIMARY="" D
112 .S SECOND=0 F S SECOND=$O(^TMP("FSC MERGE",$J,PRIMARY,SECOND)) Q:SECOND<.5 D
113 ..S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=^TMP("FSC MERGE",$J,PRIMARY,SECOND)
114 K ^TMP("FSC MERGE",$J)
115 Q
116 ;
117TEXTID(CALL) ; $$(call) -> text for tree display
118 Q $P(^FSCD("CALL",CALL,0),U)_" "_$G(^FSCD("CALL",CALL,1))
119 ;
120SAVETREE(IN,OUT) ; from FSCRPX (RPCSaveTree)
121 N CALL1,CALL2,LINE,NUM
122 S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
123 .S CALL1=$P(LINE,U),CALL2=$P(LINE,U,2)
124 .I $P($G(^FSCD("CALL",CALL2,120)),U,24)=CALL1 Q
125 .D SETUP^FSCLMPEA(CALL2,CALL1)
126 Q
127 ;
128TEST ;
129 D LOADTREE(.IN,.OUT)
130 Q
Note: See TracBrowser for help on using the repository browser.