[613] | 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
|
---|