FSCRPCUR ;SLC/STAFF-NOIS RPC User Responses ;1/13/98 16:14
;;1.1;NOIS;;Sep 06, 1998
;
RESP(IN,OUT) ; from FSCRPX (RPCGetResponse)
N CNT,LINE,NUM,RESP
S RESP=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'RESP Q
S CNT=0,NUM=0 F S NUM=$O(^FSCD("RESPONSE",RESP,1,NUM)) Q:NUM<1 D
.S CNT=CNT+1
.S LINE=$G(^FSCD("RESPONSE",RESP,1,NUM,0))
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
Q
;
RESPS(IN,OUT) ; from FSCRPX (RPCGetResponses)
N NUM,USER
S USER=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'USER Q
S NUM=0 F S NUM=$O(^FSCD("RESPONSE","C",USER,NUM)) Q:NUM<1 D
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_$P($G(^FSCD("RESPONSE",NUM,0)),U)
Q
;
DEL(IN,OUT) ; from FSCRPX (RPCDeleteResponse)
N NUM
S NUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I 'NUM Q
D DEL^FSCUCD("^FSCD(""RESPONSE"",",NUM)
Q
;
STORE(IN,OUT) ; from FSCRPX (RPCStoreResponse)
N CNT,DA,DIK,NAME,NUM,OK,LINE
S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1))
I '$L(LINE) Q
S DA=+LINE,NAME=$P(LINE,U,2)
I '$L(NAME) Q
S NAME=$$UP^XLFSTR(NAME),NAME=$TR(NAME,";""^","~~~")
I DA D
.S ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
.K ^FSCD("RESPONSE","B",DA)
.K ^FSCD("RESPONSE",DA,1)
E D I 'OK Q
.S OK=1
.L +^FSCD("RESPONSE",0):30 I '$T S OK=0 Q ; *** needs ok
.S DA=1+$P(^FSCD("RESPONSE",0),U,3)
.F Q:'$D(^FSCD("RESPONSE",DA,0)) S DA=DA+1
.S $P(^FSCD("RESPONSE",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
.S ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
.L -^FSCD("RESPONSE",0)
S DIK="^FSCD(""RESPONSE"","
D IX1^DIK
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 ^FSCD("RESPONSE",DA,1,CNT,0)=LINE
S ^FSCD("RESPONSE",DA,1,0)="^^"_CNT_U_CNT_U_DT_U
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCUR 1691 printed Apr 09, 2024@21:21:47 Page 2
FSCRPCUR ;SLC/STAFF-NOIS RPC User Responses ;1/13/98 16:14
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
RESP(IN,OUT) ; from FSCRPX (RPCGetResponse)
+1 NEW CNT,LINE,NUM,RESP
+2 SET RESP=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'RESP
QUIT
+4 SET CNT=0
SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("RESPONSE",RESP,1,NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET LINE=$GET(^FSCD("RESPONSE",RESP,1,NUM,0))
+7 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
+8 QUIT
+9 ;
RESPS(IN,OUT) ; from FSCRPX (RPCGetResponses)
+1 NEW NUM,USER
+2 SET USER=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'USER
QUIT
+4 SET NUM=0
FOR
SET NUM=$ORDER(^FSCD("RESPONSE","C",USER,NUM))
if NUM<1
QUIT
Begin DoDot:1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_$PIECE($GET(^FSCD("RESPONSE",NUM,0)),U)
End DoDot:1
+6 QUIT
+7 ;
DEL(IN,OUT) ; from FSCRPX (RPCDeleteResponse)
+1 NEW NUM
+2 SET NUM=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF 'NUM
QUIT
+4 DO DEL^FSCUCD("^FSCD(""RESPONSE"",",NUM)
+5 QUIT
+6 ;
STORE(IN,OUT) ; from FSCRPX (RPCStoreResponse)
+1 NEW CNT,DA,DIK,NAME,NUM,OK,LINE
+2 SET LINE=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF '$LENGTH(LINE)
QUIT
+4 SET DA=+LINE
SET NAME=$PIECE(LINE,U,2)
+5 IF '$LENGTH(NAME)
QUIT
+6 SET NAME=$$UP^XLFSTR(NAME)
SET NAME=$TRANSLATE(NAME,";""^","~~~")
+7 IF DA
Begin DoDot:1
+8 SET ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
+9 KILL ^FSCD("RESPONSE","B",DA)
+10 KILL ^FSCD("RESPONSE",DA,1)
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET OK=1
+13 ; *** needs ok
LOCK +^FSCD("RESPONSE",0):30
IF '$TEST
SET OK=0
QUIT
+14 SET DA=1+$PIECE(^FSCD("RESPONSE",0),U,3)
+15 FOR
if '$DATA(^FSCD("RESPONSE",DA,0))
QUIT
SET DA=DA+1
+16 SET $PIECE(^FSCD("RESPONSE",0),U,3)=DA
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+17 SET ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
+18 LOCK -^FSCD("RESPONSE",0)
End DoDot:1
IF 'OK
QUIT
+19 SET DIK="^FSCD(""RESPONSE"","
+20 DO IX1^DIK
+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 ^FSCD("RESPONSE",DA,1,CNT,0)=LINE
End DoDot:1
+24 SET ^FSCD("RESPONSE",DA,1,0)="^^"_CNT_U_CNT_U_DT_U
+25 QUIT
