Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FSCRPX

FSCRPX.m

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