FSCRPCUF ;SLC/STAFF-NOIS RPC User Formats ;1/13/98 16:13
;;1.1;NOIS;;Sep 06, 1998
;
DEL(IN,OUT) ; from FSCRPX (RPCDeleteFormat)
N NUM
S NUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'NUM Q
D DEL^FSCUCD("^FSC(""FORMAT"",",NUM)
Q
;
SETUP(IN,OUT) ; from FSCRPX (RPCSetupFormat)
N CNT,DA,DIK,LINE,NAME,NUM,OK,TYPE
S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1))
I '$L(LINE) Q
S DA=+LINE,NAME=$P(LINE,U,2),TYPE=$P(LINE,U,3)
I '$L(NAME) Q
I '(TYPE="S"!(TYPE="F")) Q
S NAME=$$UP^XLFSTR(NAME),NAME=$TR(NAME,";""^","~~~")
I DA D
.S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
.K ^FSC("FORMAT","B",DA)
.K ^FSC("FORMAT",DA,2)
E D I 'OK Q
.S OK=1
.L +^FSC("FORMAT",0):30 I '$T S OK=0 Q
.S DA=1+$P(^FSC("FORMAT",0),U,3)
.F Q:'$D(^FSC("FORMAT",DA,0)) S DA=DA+1
.S $P(^FSC("FORMAT",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
.S ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
.L -^FSC("FORMAT",0)
S DIK="^FSC(""FORMAT"","
S CNT=0,NUM=1 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
.S CNT=CNT+1
.S ^FSC("FORMAT",DA,2,CNT,0)=LINE
S ^FSC("FORMAT",DA,2,0)="^7107.62P^"_CNT_U_CNT
D IX1^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCUF 1143 printed Dec 13, 2024@02:19:53 Page 2
FSCRPCUF ;SLC/STAFF-NOIS RPC User Formats ;1/13/98 16:13
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
DEL(IN,OUT) ; from FSCRPX (RPCDeleteFormat)
+1 NEW NUM
+2 SET NUM=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'NUM
QUIT
+4 DO DEL^FSCUCD("^FSC(""FORMAT"",",NUM)
+5 QUIT
+6 ;
SETUP(IN,OUT) ; from FSCRPX (RPCSetupFormat)
+1 NEW CNT,DA,DIK,LINE,NAME,NUM,OK,TYPE
+2 SET LINE=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF '$LENGTH(LINE)
QUIT
+4 SET DA=+LINE
SET NAME=$PIECE(LINE,U,2)
SET TYPE=$PIECE(LINE,U,3)
+5 IF '$LENGTH(NAME)
QUIT
+6 IF '(TYPE="S"!(TYPE="F"))
QUIT
+7 SET NAME=$$UP^XLFSTR(NAME)
SET NAME=$TRANSLATE(NAME,";""^","~~~")
+8 IF DA
Begin DoDot:1
+9 SET ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
+10 KILL ^FSC("FORMAT","B",DA)
+11 KILL ^FSC("FORMAT",DA,2)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET OK=1
+14 LOCK +^FSC("FORMAT",0):30
IF '$TEST
SET OK=0
QUIT
+15 SET DA=1+$PIECE(^FSC("FORMAT",0),U,3)
+16 FOR
if '$DATA(^FSC("FORMAT",DA,0))
QUIT
SET DA=DA+1
+17 SET $PIECE(^FSC("FORMAT",0),U,3)=DA
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+18 SET ^FSC("FORMAT",DA,0)=NAME_U_TYPE_U_U_U_DUZ
+19 LOCK -^FSC("FORMAT",0)
End DoDot:1
IF 'OK
QUIT
+20 SET DIK="^FSC(""FORMAT"","
+21 SET CNT=0
SET NUM=1
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+22 SET CNT=CNT+1
+23 SET ^FSC("FORMAT",DA,2,CNT,0)=LINE
End DoDot:1
+24 SET ^FSC("FORMAT",DA,2,0)="^7107.62P^"_CNT_U_CNT
+25 DO IX1^DIK
+26 QUIT
