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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPX 3554 printed Nov 22, 2024@17:30:02 Page 2
FSCRPX ;SLC/STAFF-NOIS RPC Process ;03/16/2005 08:58
+1 ;;1.1;NOIS;**2**;Sep 06, 1998
+2 ;
RPC(OUTPUT,INPUT) ;
+1 ; routes all NOIS Workstation Calls
+2 ; ensures user is authorized to use NOIS
+3 ; input array sent from client should be within a safe partition size
+4 ; IN and OUT arrays are not being used, param passing uses TMP instead
+5 NEW FSCDEV,FIRSTNUM,IN,INLINE,MAX,NUM,OK,OUT,OUTLINE,RTN,START
KILL IN,OUT
+6 ; max # lines that can be sent to client
SET MAX=30
+7 SET FSCDEV=1
+8 SET FIRSTNUM=+$ORDER(INPUT(""))
+9 SET INLINE=$GET(INPUT(FIRSTNUM))
+10 SET OK=1
+11 ; 1st input
IF $PIECE(INLINE,U,10)=1
Begin DoDot:1
+12 KILL ^TMP("FSCRPC",$JOB)
+13 DO SHUTDOWN(INLINE,$GET(INPUT(1)),.OK)
+14 IF 'OK
Begin DoDot:2
+15 SET ^TMP("FSCRPC",$JOB,"OUTPUT",0)="^1"
+16 SET OUTPUT=$NAME(^TMP("FSCRPC",$JOB,"OUTPUT"))
End DoDot:2
QUIT
+17 MERGE ^TMP("FSCRPC",$JOB,"INPUT")=INPUT
End DoDot:1
IF 'OK
QUIT
+18 IF '$TEST
Begin DoDot:1
+19 ; more input being sent
IF $PIECE(INLINE,U,4)
Begin DoDot:2
+20 SET START=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",""),-1)
+21 SET NUM=0
FOR
SET NUM=$ORDER(INPUT(NUM))
if NUM<1
QUIT
Begin DoDot:3
+22 SET START=START+1
+23 SET ^TMP("FSCRPC",$JOB,"INPUT",START)=INPUT(NUM)
End DoDot:3
End DoDot:2
End DoDot:1
+24 KILL INPUT,OUTPUT
+25 SET OUTLINE="^0"
+26 SET OK=1
+27 IF $EXTRACT($PIECE(INLINE,U,2),1,6)="FSCRPC"
Begin DoDot:1
+28 ;****
SET RTN=$PIECE(INLINE,U,1,2)
SET FSCZZRTN=RTN
+29 ; cancel if invalid routine
IF '$LENGTH($TEXT(@RTN))
SET $PIECE(OUTLINE,U,3)=1
QUIT
+30 ; don't process until no more input
IF $PIECE(INLINE,U,4)
QUIT
+31 ; send more output
IF $PIECE(INLINE,U,5)
DO MORE(MAX,OUTLINE,.OUTPUT)
SET OK=0
QUIT
+32 KILL ^TMP("FSCRPC",$JOB,"OUTPUT")
+33 SET RTN=RTN_"(.IN,.OUT)"
DO @RTN
+34 DO MENUS^FSCRPXM(DUZ,.OUTLINE,INLINE)
+35 KILL ^TMP("FSCRPC",$JOB,"INPUT")
End DoDot:1
IF 'OK
QUIT
+36 ;*2
SET OUTLINE=$GET(^TMP("FSCRPC",$JOB,"OUTPUT"))_OUTLINE
SET ^TMP("FSCRPC",$JOB,"OUTPUT")=""
+37 ;I +$G(^TMP("FSCRPC",$J,"OUTPUT"))<MAX D ;*2
+38 ;*2
IF +OUTLINE<MAX
Begin DoDot:1
+39 SET ^TMP("FSCRPC",$JOB,"OUTPUT",0)=OUTLINE
+40 SET OUTPUT=$NAME(^TMP("FSCRPC",$JOB,"OUTPUT"))
End DoDot:1
+41 IF '$TEST
DO MORE(MAX,OUTLINE,.OUTPUT)
+42 QUIT
+43 ;
MORE(MAX,OUTLINE,OUTPUT) ;
+1 NEW CNT,COUNT,LINE,NUM
+2 KILL ^TMP("FSCRPC",$JOB,"OUTPUTLONG")
+3 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"OUTPUT",NUM))
if NUM<1
QUIT
if CNT'<MAX
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUTLONG",CNT)=LINE
+6 KILL ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)
End DoDot:1
+7 ; more to come
IF $ORDER(^TMP("FSCRPC",$JOB,"OUTPUT",0))>0
SET $PIECE(OUTLINE,U,5)=1
+8 IF '$TEST
SET $PIECE(OUTLINE,U,5)=0
KILL ^TMP("FSCRPC",$JOB,"INPUT"),^TMP("FSCRPC",$JOB,"OUTPUT")
+9 SET ^TMP("FSCRPC",$JOB,"OUTPUTLONG",0)=OUTLINE
+10 SET OUTPUT=$NAME(^TMP("FSCRPC",$JOB,"OUTPUTLONG"))
+11 QUIT
+12 ;
SHUTDOWN(INLINE,ONELINE,OK) ; 'OK to shutdown applications
+1 NEW MSG,NOW,RTN,VERSION
+2 IF $PIECE($GET(^FSC("PARAM",1,2)),U)
SET OK=0
Begin DoDot:1
+3 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="NOIS server software has been turned off."
End DoDot:1
QUIT
+4 SET RTN=$PIECE(INLINE,U,1,2)
IF RTN="ALERTCHK^FSCRPC"
QUIT
+5 IF $LENGTH(RTN)>1
Begin DoDot:1
+6 SET NOW=$$NOW^XLFDT
+7 IF $EXTRACT($PIECE(RTN,U,2),1,6)'="FSCRPC"
Begin DoDot:2
+8 SET OK=0
+9 SET ^XTMP("FSCRPC","##"_RTN_"##",DUZ,NOW)=""
End DoDot:2
QUIT
+10 IF RTN="STARTUP^FSCRPC"
Begin DoDot:2
+11 ; this is a menu screen on Forum to restrict NON GOV users
IF $DATA(^VA(200,"E",1,DUZ))
SET ^XTMP("FSCRPC","##"_DUZ_"##",NOW)=""
SET OK=0
Begin DoDot:3
+12 SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)="You do not have access to NOIS."
End DoDot:3
QUIT
+13 SET ^XTMP("FSCRPC","<STARTUP>",-NOW,DUZ)=""
+14 SET VERSION=ONELINE
+15 SET ^XTMP("FSCRPC","<VERSION>",DUZ)=VERSION
+16 DO BADVER(VERSION,.OK,.MSG)
+17 IF 'OK
SET ^TMP("FSCRPC",$JOB,"OUTPUT",1)=MSG
End DoDot:2
QUIT
+18 SET ^(RTN)=1+$GET(^XTMP("FSCRPC",RTN))
+19 SET ^(RTN)=1+$GET(^XTMP("FSCRPC","ZZUSER",DUZ,RTN))
End DoDot:1
IF 'OK
QUIT
+20 QUIT
+21 ;
BADVER(VERSION,OK,MSG) ;
+1 NEW SVERSION
+2 SET SVERSION=$PIECE($GET(^FSC("PARAM",1,2)),U,7)
+3 SET OK=1
SET MSG=""
+4 IF '$LENGTH(SVERSION)
QUIT
+5 IF VERSION["T"
SET VERSION=+VERSION-.01+($PIECE(VERSION,"T",2)*.001)
+6 IF SVERSION'>+VERSION
QUIT
+7 SET OK=0
+8 SET MSG=$PIECE($GET(^FSC("PARAM",1,3)),U)
+9 IF '$LENGTH(MSG)
SET MSG="You're software must be updated to "_SVERSION_"."
+10 QUIT
