FSCRPXG ;SLC/STAFF-NOIS RPC Driver - General Use ;1/13/98 16:36
;;1.1;NOIS;;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,INLINE,IN,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)
.I $$SHUTDOWN D Q
..S OK=0
..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)
.;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)
.K ^TMP("FSCRPC",$J,"INPUT")
I +$G(^TMP("FSCRPC",$J,"OUTPUT"))<MAX D
.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
;
TEST(X) ; $$(routine entry) -> 0 or 1 if exists on system
X ^%ZOSF("TEST") Q $T
;
SHUTDOWN() ; $$ -> 1 or 0 to shutdown applications
I $P($G(^FSC("PARAM",1,2)),U) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPXG 2328 printed Apr 09, 2024@21:20:35 Page 2
FSCRPXG ;SLC/STAFF-NOIS RPC Driver - General Use ;1/13/98 16:36
+1 ;;1.1;NOIS;;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,INLINE,IN,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 IF $$SHUTDOWN
Begin DoDot:2
+14 SET OK=0
+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)
+29 ;I '$L($T(@RTN)) S $P(OUTLINE,U,3)=1 Q ; cancel if invalid routine
+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 ;D MENUS^FSCRPXM(DUZ,.OUTLINE)
+35 KILL ^TMP("FSCRPC",$JOB,"INPUT")
End DoDot:1
IF 'OK
QUIT
+36 IF +$GET(^TMP("FSCRPC",$JOB,"OUTPUT"))<MAX
Begin DoDot:1
+37 SET ^TMP("FSCRPC",$JOB,"OUTPUT",0)=OUTLINE
+38 SET OUTPUT=$NAME(^TMP("FSCRPC",$JOB,"OUTPUT"))
End DoDot:1
+39 IF '$TEST
DO MORE(MAX,OUTLINE,.OUTPUT)
+40 QUIT
+41 ;
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 ;
TEST(X) ; $$(routine entry) -> 0 or 1 if exists on system
+1 XECUTE ^%ZOSF("TEST")
QUIT $TEST
+2 ;
SHUTDOWN() ; $$ -> 1 or 0 to shutdown applications
+1 IF $PIECE($GET(^FSC("PARAM",1,2)),U)
QUIT 1
+2 QUIT 0
