source: WorldVistAEHR/trunk/r/NOIS-FSC/FSCRPX.m@ 1042

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

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1FSCRPX ;SLC/STAFF-NOIS RPC Process ;03/16/2005 08:58
2 ;;1.1;NOIS;**2**;Sep 06, 1998
3 ;
4RPC(OUTPUT,INPUT) ;
5 ; routes all NOIS Workstation Calls
6 ; ensures user is authorized to use NOIS
7 ; input array sent from client should be within a safe partition size
8 ; IN and OUT arrays are not being used, param passing uses TMP instead
9 N FSCDEV,FIRSTNUM,IN,INLINE,MAX,NUM,OK,OUT,OUTLINE,RTN,START K IN,OUT
10 S MAX=30 ; max # lines that can be sent to client
11 S FSCDEV=1
12 S FIRSTNUM=+$O(INPUT(""))
13 S INLINE=$G(INPUT(FIRSTNUM))
14 S OK=1
15 I $P(INLINE,U,10)=1 D I 'OK Q ; 1st input
16 .K ^TMP("FSCRPC",$J)
17 .D SHUTDOWN(INLINE,$G(INPUT(1)),.OK)
18 .I 'OK D Q
19 ..S ^TMP("FSCRPC",$J,"OUTPUT",0)="^1"
20 ..S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUT"))
21 .M ^TMP("FSCRPC",$J,"INPUT")=INPUT
22 E D
23 .I $P(INLINE,U,4) D ; more input being sent
24 ..S START=$O(^TMP("FSCRPC",$J,"INPUT",""),-1)
25 ..S NUM=0 F S NUM=$O(INPUT(NUM)) Q:NUM<1 D
26 ...S START=START+1
27 ...S ^TMP("FSCRPC",$J,"INPUT",START)=INPUT(NUM)
28 K INPUT,OUTPUT
29 S OUTLINE="^0"
30 S OK=1
31 I $E($P(INLINE,U,2),1,6)="FSCRPC" D I 'OK Q
32 .S RTN=$P(INLINE,U,1,2),FSCZZRTN=RTN ;****
33 .I '$L($T(@RTN)) S $P(OUTLINE,U,3)=1 Q ; cancel if invalid routine
34 .I $P(INLINE,U,4) Q ; don't process until no more input
35 .I $P(INLINE,U,5) D MORE(MAX,OUTLINE,.OUTPUT) S OK=0 Q ; send more output
36 .K ^TMP("FSCRPC",$J,"OUTPUT")
37 .S RTN=RTN_"(.IN,.OUT)" D @RTN
38 .D MENUS^FSCRPXM(DUZ,.OUTLINE,INLINE)
39 .K ^TMP("FSCRPC",$J,"INPUT")
40 S OUTLINE=$G(^TMP("FSCRPC",$J,"OUTPUT"))_OUTLINE,^TMP("FSCRPC",$J,"OUTPUT")="" ;*2
41 ;I +$G(^TMP("FSCRPC",$J,"OUTPUT"))<MAX D ;*2
42 I +OUTLINE<MAX D ;*2
43 .S ^TMP("FSCRPC",$J,"OUTPUT",0)=OUTLINE
44 .S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUT"))
45 E D MORE(MAX,OUTLINE,.OUTPUT)
46 Q
47 ;
48MORE(MAX,OUTLINE,OUTPUT) ;
49 N CNT,COUNT,LINE,NUM
50 K ^TMP("FSCRPC",$J,"OUTPUTLONG")
51 S (CNT,NUM)=0 F S NUM=$O(^TMP("FSCRPC",$J,"OUTPUT",NUM)) Q:NUM<1 Q:CNT'<MAX S LINE=^(NUM) D
52 .S CNT=CNT+1
53 .S ^TMP("FSCRPC",$J,"OUTPUTLONG",CNT)=LINE
54 .K ^TMP("FSCRPC",$J,"OUTPUT",NUM)
55 I $O(^TMP("FSCRPC",$J,"OUTPUT",0))>0 S $P(OUTLINE,U,5)=1 ; more to come
56 E S $P(OUTLINE,U,5)=0 K ^TMP("FSCRPC",$J,"INPUT"),^TMP("FSCRPC",$J,"OUTPUT")
57 S ^TMP("FSCRPC",$J,"OUTPUTLONG",0)=OUTLINE
58 S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUTLONG"))
59 Q
60 ;
61SHUTDOWN(INLINE,ONELINE,OK) ; 'OK to shutdown applications
62 N MSG,NOW,RTN,VERSION
63 I $P($G(^FSC("PARAM",1,2)),U) S OK=0 D Q
64 .S ^TMP("FSCRPC",$J,"OUTPUT",1)="NOIS server software has been turned off."
65 S RTN=$P(INLINE,U,1,2) I RTN="ALERTCHK^FSCRPC" Q
66 I $L(RTN)>1 D I 'OK Q
67 .S NOW=$$NOW^XLFDT
68 .I $E($P(RTN,U,2),1,6)'="FSCRPC" D Q
69 ..S OK=0
70 ..S ^XTMP("FSCRPC","##"_RTN_"##",DUZ,NOW)=""
71 .I RTN="STARTUP^FSCRPC" D Q
72 ..I $D(^VA(200,"E",1,DUZ)) S ^XTMP("FSCRPC","##"_DUZ_"##",NOW)="",OK=0 D Q ; this is a menu screen on Forum to restrict NON GOV users
73 ...S ^TMP("FSCRPC",$J,"OUTPUT",1)="You do not have access to NOIS."
74 ..S ^XTMP("FSCRPC","<STARTUP>",-NOW,DUZ)=""
75 ..S VERSION=ONELINE
76 ..S ^XTMP("FSCRPC","<VERSION>",DUZ)=VERSION
77 ..D BADVER(VERSION,.OK,.MSG)
78 ..I 'OK S ^TMP("FSCRPC",$J,"OUTPUT",1)=MSG
79 .S ^(RTN)=1+$G(^XTMP("FSCRPC",RTN))
80 .S ^(RTN)=1+$G(^XTMP("FSCRPC","ZZUSER",DUZ,RTN))
81 Q
82 ;
83BADVER(VERSION,OK,MSG) ;
84 N SVERSION
85 S SVERSION=$P($G(^FSC("PARAM",1,2)),U,7)
86 S OK=1,MSG=""
87 I '$L(SVERSION) Q
88 I VERSION["T" S VERSION=+VERSION-.01+($P(VERSION,"T",2)*.001)
89 I SVERSION'>+VERSION Q
90 S OK=0
91 S MSG=$P($G(^FSC("PARAM",1,3)),U)
92 I '$L(MSG) S MSG="You're software must be updated to "_SVERSION_"."
93 Q
Note: See TracBrowser for help on using the repository browser.