source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCUF.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1FSCRPCUF ;SLC/STAFF-NOIS RPC User Formats ;1/13/98 16:13
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4DEL(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 ;
11SETUP(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
Note: See TracBrowser for help on using the repository browser.