source: FOIAVistA/tag/r/NOIS-FSC/FSCRPX.m@ 1302

FSCRPX ;SLC/STAFF-NOIS RPC Process ;03/16/2005  08:58
 ;;1.1;NOIS;**2**;Sep 06, 1998
 ;
RPC(OUTPUT,INPUT) ;
 ; routes all NOIS Workstation Calls
 ; ensures user is authorized to use NOIS
 ; input array sent from client should be within a safe partition size
 ; IN and OUT arrays are not being used, param passing uses TMP instead
 N FSCDEV,FIRSTNUM,IN,INLINE,MAX,NUM,OK,OUT,OUTLINE,RTN,START K IN,OUT
 S MAX=30 ; max # lines that can be sent to client
 S FSCDEV=1
 S FIRSTNUM=+$O(INPUT(""))
 S INLINE=$G(INPUT(FIRSTNUM))
 S OK=1
 I $P(INLINE,U,10)=1 D  I 'OK Q  ; 1st input
 .K ^TMP("FSCRPC",$J)
 .D SHUTDOWN(INLINE,$G(INPUT(1)),.OK)
 .I 'OK D  Q
 ..S ^TMP("FSCRPC",$J,"OUTPUT",0)="^1"
 ..S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUT"))
 .M ^TMP("FSCRPC",$J,"INPUT")=INPUT
 E  D
 .I $P(INLINE,U,4) D  ; more input being sent
 ..S START=$O(^TMP("FSCRPC",$J,"INPUT",""),-1)
 ..S NUM=0 F  S NUM=$O(INPUT(NUM)) Q:NUM<1  D
 ...S START=START+1
 ...S ^TMP("FSCRPC",$J,"INPUT",START)=INPUT(NUM)
 K INPUT,OUTPUT
 S OUTLINE="^0"
 S OK=1
 I $E($P(INLINE,U,2),1,6)="FSCRPC" D  I 'OK Q
 .S RTN=$P(INLINE,U,1,2),FSCZZRTN=RTN ;****
 .I '$L($T(@RTN)) S $P(OUTLINE,U,3)=1 Q  ; cancel if invalid routine
 .I $P(INLINE,U,4) Q  ; don't process until no more input
 .I $P(INLINE,U,5) D MORE(MAX,OUTLINE,.OUTPUT) S OK=0 Q  ; send more output
 .K ^TMP("FSCRPC",$J,"OUTPUT")
 .S RTN=RTN_"(.IN,.OUT)" D @RTN
 .D MENUS^FSCRPXM(DUZ,.OUTLINE,INLINE)
 .K ^TMP("FSCRPC",$J,"INPUT")
 S OUTLINE=$G(^TMP("FSCRPC",$J,"OUTPUT"))_OUTLINE,^TMP("FSCRPC",$J,"OUTPUT")="" ;*2
 ;I +$G(^TMP("FSCRPC",$J,"OUTPUT"))<MAX D  ;*2
 I +OUTLINE<MAX D  ;*2
 .S ^TMP("FSCRPC",$J,"OUTPUT",0)=OUTLINE
 .S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUT"))
 E  D MORE(MAX,OUTLINE,.OUTPUT)
 Q
 ;
MORE(MAX,OUTLINE,OUTPUT) ;
 N CNT,COUNT,LINE,NUM
 K ^TMP("FSCRPC",$J,"OUTPUTLONG")
 S (CNT,NUM)=0 F  S NUM=$O(^TMP("FSCRPC",$J,"OUTPUT",NUM)) Q:NUM<1  Q:CNT'<MAX  S LINE=^(NUM) D
 .S CNT=CNT+1
 .S ^TMP("FSCRPC",$J,"OUTPUTLONG",CNT)=LINE
 .K ^TMP("FSCRPC",$J,"OUTPUT",NUM)
 I $O(^TMP("FSCRPC",$J,"OUTPUT",0))>0 S $P(OUTLINE,U,5)=1 ; more to come
 E  S $P(OUTLINE,U,5)=0 K ^TMP("FSCRPC",$J,"INPUT"),^TMP("FSCRPC",$J,"OUTPUT")
 S ^TMP("FSCRPC",$J,"OUTPUTLONG",0)=OUTLINE
 S OUTPUT=$NA(^TMP("FSCRPC",$J,"OUTPUTLONG"))
 Q
 ;
SHUTDOWN(INLINE,ONELINE,OK) ; 'OK to shutdown applications
 N MSG,NOW,RTN,VERSION
 I $P($G(^FSC("PARAM",1,2)),U) S OK=0 D  Q
 .S ^TMP("FSCRPC",$J,"OUTPUT",1)="NOIS server software has been turned off."
 S RTN=$P(INLINE,U,1,2) I RTN="ALERTCHK^FSCRPC" Q
 I $L(RTN)>1 D  I 'OK Q
 .S NOW=$$NOW^XLFDT
 .I $E($P(RTN,U,2),1,6)'="FSCRPC" D  Q
 ..S OK=0
 ..S ^XTMP("FSCRPC","##"_RTN_"##",DUZ,NOW)=""
 .I RTN="STARTUP^FSCRPC" D  Q
 ..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
 ...S ^TMP("FSCRPC",$J,"OUTPUT",1)="You do not have access to NOIS."
 ..S ^XTMP("FSCRPC","<STARTUP>",-NOW,DUZ)=""
 ..S VERSION=ONELINE
 ..S ^XTMP("FSCRPC","<VERSION>",DUZ)=VERSION
 ..D BADVER(VERSION,.OK,.MSG)
 ..I 'OK S ^TMP("FSCRPC",$J,"OUTPUT",1)=MSG
 .S ^(RTN)=1+$G(^XTMP("FSCRPC",RTN))
 .S ^(RTN)=1+$G(^XTMP("FSCRPC","ZZUSER",DUZ,RTN))
 Q
 ;
BADVER(VERSION,OK,MSG) ;
 N SVERSION
 S SVERSION=$P($G(^FSC("PARAM",1,2)),U,7)
 S OK=1,MSG=""
 I '$L(SVERSION) Q
 I VERSION["T" S VERSION=+VERSION-.01+($P(VERSION,"T",2)*.001)
 I SVERSION'>+VERSION Q
 S OK=0
 S MSG=$P($G(^FSC("PARAM",1,3)),U)
 I '$L(MSG) S MSG="You're software must be updated to "_SVERSION_"."
 Q