- 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 Feb 18, 2025@23:46:18 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
