| 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
 | 
|---|