FSCRPCUA ;SLC/STAFF-NOIS RPC User Affiliations ;1/31/98 21:14
;;1.1;NOIS;;Sep 06, 1998
;
SETUP(IN,OUT) ; from FSCRPX (RPCAffiliations)
N CNT,DA,DIE,DIK,DR,NUM,OK,PACK
; ignore first line
S DA=DUZ
I '$O(^TMP("FSCRPC",$J,"INPUT",1)) D Q
.I '$L($G(^FSC("SPEC",DA,0))) Q
.D DEL(DA)
I $L($G(^FSC("SPEC",DA,0))) D DEL(DA)
I '$L($G(^FSC("SPEC",DA,0))) S OK=1 D I 'OK Q
.L +^FSC("SPEC",0):30 I '$T S OK=0 Q
.S $P(^FSC("SPEC",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
.S ^FSC("SPEC",DA,0)=DA,^FSC("SPEC","B",DA,DA)=""
.L -^FSC("SPEC",0)
S OK=1 D I 'OK Q
.S DIE=7105.2,DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL"
.L +^FSC("SPEC",DA):30 I '$T S OK=0 Q
.D ^DIE
.L -^FSC("SPEC",DA)
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
.S CNT=CNT+1
.S ^FSC("SPEC",DA,30,CNT,0)=PACK
S ^FSC("SPEC",DA,30,0)="^7105.23P^"_CNT_U_CNT
S DIK="^FSC(""SPEC"","
D IX1^DIK
Q
;
DEL(USER) ;
N NUM
I '$L($G(^FSC("SPEC",USER,0))) Q
S NUM=0 F S NUM=$O(^FSC("SPEC",USER,30,"B",NUM)) Q:NUM<1 D
.K ^FSC("SPEC","AP",NUM,USER)
K ^FSC("SPEC",USER,30)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCUA 1153 printed Apr 09, 2024@21:21:55 Page 2
FSCRPCUA ;SLC/STAFF-NOIS RPC User Affiliations ;1/31/98 21:14
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
SETUP(IN,OUT) ; from FSCRPX (RPCAffiliations)
+1 NEW CNT,DA,DIE,DIK,DR,NUM,OK,PACK
+2 ; ignore first line
+3 SET DA=DUZ
+4 IF '$ORDER(^TMP("FSCRPC",$JOB,"INPUT",1))
Begin DoDot:1
+5 IF '$LENGTH($GET(^FSC("SPEC",DA,0)))
QUIT
+6 DO DEL(DA)
End DoDot:1
QUIT
+7 IF $LENGTH($GET(^FSC("SPEC",DA,0)))
DO DEL(DA)
+8 IF '$LENGTH($GET(^FSC("SPEC",DA,0)))
SET OK=1
Begin DoDot:1
+9 LOCK +^FSC("SPEC",0):30
IF '$TEST
SET OK=0
QUIT
+10 SET $PIECE(^FSC("SPEC",0),U,3)=DA
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+11 SET ^FSC("SPEC",DA,0)=DA
SET ^FSC("SPEC","B",DA,DA)=""
+12 LOCK -^FSC("SPEC",0)
End DoDot:1
IF 'OK
QUIT
+13 SET OK=1
Begin DoDot:1
+14 SET DIE=7105.2
SET DR="1///1;10.1///ALERT;10.2///EDITED;10.3///ALL"
+15 LOCK +^FSC("SPEC",DA):30
IF '$TEST
SET OK=0
QUIT
+16 DO ^DIE
+17 LOCK -^FSC("SPEC",DA)
End DoDot:1
IF 'OK
QUIT
+18 SET CNT=0
SET NUM=1
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET PACK=+^(NUM)
IF $LENGTH($GET(^FSC("PACK",PACK,0)))
Begin DoDot:1
+19 SET CNT=CNT+1
+20 SET ^FSC("SPEC",DA,30,CNT,0)=PACK
End DoDot:1
+21 SET ^FSC("SPEC",DA,30,0)="^7105.23P^"_CNT_U_CNT
+22 SET DIK="^FSC(""SPEC"","
+23 DO IX1^DIK
+24 QUIT
+25 ;
DEL(USER) ;
+1 NEW NUM
+2 IF '$LENGTH($GET(^FSC("SPEC",USER,0)))
QUIT
+3 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("SPEC",USER,30,"B",NUM))
if NUM<1
QUIT
Begin DoDot:1
+4 KILL ^FSC("SPEC","AP",NUM,USER)
End DoDot:1
+5 KILL ^FSC("SPEC",USER,30)
+6 QUIT
