source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPCUR.m@ 841

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1FSCRPCUR ;SLC/STAFF-NOIS RPC User Responses ;1/13/98 16:14
2 ;;1.1;NOIS;;Sep 06, 1998
3 ;
4RESP(IN,OUT) ; from FSCRPX (RPCGetResponse)
5 N CNT,LINE,NUM,RESP
6 S RESP=+$G(^TMP("FSCRPC",$J,"INPUT",1))
7 I 'RESP Q
8 S CNT=0,NUM=0 F S NUM=$O(^FSCD("RESPONSE",RESP,1,NUM)) Q:NUM<1 D
9 .S CNT=CNT+1
10 .S LINE=$G(^FSCD("RESPONSE",RESP,1,NUM,0))
11 .S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
12 Q
13 ;
14RESPS(IN,OUT) ; from FSCRPX (RPCGetResponses)
15 N NUM,USER
16 S USER=+$G(^TMP("FSCRPC",$J,"INPUT",1))
17 I 'USER Q
18 S NUM=0 F S NUM=$O(^FSCD("RESPONSE","C",USER,NUM)) Q:NUM<1 D
19 .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_$P($G(^FSCD("RESPONSE",NUM,0)),U)
20 Q
21 ;
22DEL(IN,OUT) ; from FSCRPX (RPCDeleteResponse)
23 N NUM
24 S NUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
25 I 'NUM Q
26 D DEL^FSCUCD("^FSCD(""RESPONSE"",",NUM)
27 Q
28 ;
29STORE(IN,OUT) ; from FSCRPX (RPCStoreResponse)
30 N CNT,DA,DIK,NAME,NUM,OK,LINE
31 S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1))
32 I '$L(LINE) Q
33 S DA=+LINE,NAME=$P(LINE,U,2)
34 I '$L(NAME) Q
35 S NAME=$$UP^XLFSTR(NAME),NAME=$TR(NAME,";""^","~~~")
36 I DA D
37 .S ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
38 .K ^FSCD("RESPONSE","B",DA)
39 .K ^FSCD("RESPONSE",DA,1)
40 E D I 'OK Q
41 .S OK=1
42 .L +^FSCD("RESPONSE",0):30 I '$T S OK=0 Q ; *** needs ok
43 .S DA=1+$P(^FSCD("RESPONSE",0),U,3)
44 .F Q:'$D(^FSCD("RESPONSE",DA,0)) S DA=DA+1
45 .S $P(^FSCD("RESPONSE",0),U,3)=DA,$P(^(0),U,4)=$P(^(0),U,4)+1
46 .S ^FSCD("RESPONSE",DA,0)=NAME_U_DUZ
47 .L -^FSCD("RESPONSE",0)
48 S DIK="^FSCD(""RESPONSE"","
49 D IX1^DIK
50 S CNT=0,NUM=1 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
51 .S CNT=CNT+1
52 .S ^FSCD("RESPONSE",DA,1,CNT,0)=LINE
53 S ^FSCD("RESPONSE",DA,1,0)="^^"_CNT_U_CNT_U_DT_U
54 Q
Note: See TracBrowser for help on using the repository browser.