1 | FSCRPCUF ;SLC/STAFF-NOIS RPC User Formats ;1/13/98 16:13
|
---|
2 | ;;1.1;NOIS;;Sep 06, 1998
|
---|
3 | ;
|
---|
4 | DEL(IN,OUT) ; from FSCRPX (RPCDeleteFormat)
|
---|
5 | N NUM
|
---|
6 | S NUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
|
---|
7 | I 'NUM Q
|
---|
8 | D DEL^FSCUCD("^FSC(""FORMAT"",",NUM)
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | SETUP(IN,OUT) ; from FSCRPX (RPCSetupFormat)
|
---|
12 | N CNT,DA,DIK,LINE,NAME,NUM,OK,TYPE
|
---|
13 | S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1))
|
---|
14 | I '$L(LINE) Q
|
---|
15 | S DA=+LINE,NAME=$P(LINE,U,2),TYPE=$P(LINE,U,3)
|
---|
16 | I '$L(NAME) Q
|
---|
17 | I '(TYPE="S"!(TYPE="F")) Q
|
---|
18 | S NAME=$$UP^XLFSTR(NAME),NAME=$TR(NAME,";""^","~~~")
|
---|
19 | I DA D
|
---|
20 | .S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
|
---|
21 | .K ^FSC("FORMAT","B",DA)
|
---|
22 | .K ^FSC("FORMAT",DA,2)
|
---|
23 | E D I 'OK Q
|
---|
24 | .S OK=1
|
---|
25 | .L +^FSC("FORMAT",0):30 I '$T S OK=0 Q
|
---|
26 | .S DA=1+$P(^FSC("FORMAT",0),U,3)
|
---|
27 | .F Q:'$D(^FSC("FORMAT",DA,0)) S DA=DA+1
|
---|
28 | .S $P(^FSC("FORMAT",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
|
---|
29 | .S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
|
---|
30 | .L -^FSC("FORMAT",0)
|
---|
31 | S DIK="^FSC(""FORMAT"","
|
---|
32 | S CNT=0,NUM=1 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
|
---|
33 | .S CNT=CNT+1
|
---|
34 | .S ^FSC("FORMAT",DA,2,CNT,0)=LINE
|
---|
35 | S ^FSC("FORMAT",DA,2,0)="^7107.62P^"_CNT_U_CNT
|
---|
36 | D IX1^DIK
|
---|
37 | Q
|
---|