source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCUA.m@ 691

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1FSCRPCUA ;SLC/STAFF-NOIS RPC User Affiliations ;1/31/98 21:14
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4SETUP(IN,OUT) ; from FSCRPX (RPCAffiliations)
5 N CNT,DA,DIE,DIK,DR,NUM,OK,PACK
6 ; ignore first line
7 S DA=DUZ
8 I '$O(^TMP("FSCRPC",$J,"INPUT",1)) D Q
9 .I '$L($G(^FSC("SPEC",DA,0))) Q
10 .D DEL(DA)
11 I $L($G(^FSC("SPEC",DA,0))) D DEL(DA)
12 I '$L($G(^FSC("SPEC",DA,0))) S OK=1 D I 'OK Q
13 .L +^FSC("SPEC",0):30 I '$T S OK=0 Q
14 .S $P(^FSC("SPEC",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
15 .S ^FSC("SPEC",DA,0)=DA,^FSC("SPEC","B",DA,DA)=""
16 .L -^FSC("SPEC",0)
17 S OK=1 D I 'OK Q
18 .S DIE=7105.2,DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL"
19 .L +^FSC("SPEC",DA):30 I '$T S OK=0 Q
20 .D ^DIE
21 .L -^FSC("SPEC",DA)
22 S CNT=0,NUM=1 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S PACK=+^(NUM) I $L($G(^FSC("PACK",PACK,0))) D
23 .S CNT=CNT+1
24 .S ^FSC("SPEC",DA,30,CNT,0)=PACK
25 S ^FSC("SPEC",DA,30,0)="^7105.23P^"_CNT_U_CNT
26 S DIK="^FSC(""SPEC"","
27 D IX1^DIK
28 Q
29 ;
30DEL(USER) ;
31 N NUM
32 I '$L($G(^FSC("SPEC",USER,0))) Q
33 S NUM=0 F S NUM=$O(^FSC("SPEC",USER,30,"B",NUM)) Q:NUM<1 D
34 .K ^FSC("SPEC","AP",NUM,USER)
35 K ^FSC("SPEC",USER,30)
36 Q
Note: See TracBrowser for help on using the repository browser.