- 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 Feb 18, 2025@23:46:29 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