XQSRV5 ;MJM/SEA - Check out a server option server;11/9/92 9:54 AM ;01/09/2001 13:32 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**155**;Jul 10, 1995
;
;This routine is called by the option XQSCHK. It does various
;checks on a server option whose name is stored in the first
;line of message that has activated this program.
;
;The variable X contains 4 "^" pieces: OPTION NAME ^ MESSAGE # ^
;SENDER ^ MESSAGE SUBJECT
;
;
START S XQX=X,XQHERE=^XMB("NETNAME"),XQI=0,XQSRV5="",XQAUDIT=0
D ^XQDATE S XQDATE=%Y
S XQSTXT(XQI)="This is a reply from: "_XQHERE,XQI=XQI+1
S XQMSG=$P(XQX,U,2),XQSND=$P(XQX,U,3),XQSUB=$P(XQX,U,4,99)
S:'$D(XMZ) XMZ=$P(XQX,U,2) F %=1:1:5 X XMREC S %X=XMRG D CNVT S XMRG=%X Q:XMRG]""!(XMER<0)
S XQSOP=XMRG I XMER<0!(XQSOP']"") S XQSTXT(XQI)="Can't unload name of server from message: "_XQSUB,XQI=XQI+1 G OUT
E S XQSTXT(XQI)="Checking server option "_XQSOP_".",XQI=XQI+1
S XQY=$O(^DIC(19,"B",XQSOP,0)) I XQY="" S XQSTXT(XQI)="The option "_XQSOP_" is not in the Option File.",XQI=XQI+1 G OUT
S XQY0=^DIC(19,XQY,0)
;
DIC ;Look up option, check it's type and parameters
I 'XQAUDIT S XQN="" F XQII=0:0 S XQN=$O(^XTV(8989.3,1,19.2,"B",XQN)) Q:XQN="" S:($E(XQSOP,1,$L(XQN))=XQN) XQAUDIT=1 I XQAUDIT S XQSTART=^XTV(8989.3,1,19),XQEND=$P(XQSTART,U,3),XQSTART=$P(XQSTART,U,2) S:DT<XQSTART!(DT>XQEND) XQAUDIT=0
I $P(XQY0,U,4)'["S" S %=$P(XQY0,U,4),XQSTXT(XQI)="Option "_XQSOP_" is not shown as a server-type option but an "_%_". Should be 'S'.",XQI=XQI+1
I $P(XQY0,U,3)'="" S XQSTXT(XQI)=XQSOP_" is marked Out Of Order with the message: "_$P(XQY0,U,3),XQI=XQI+1
;
XQ220 ;Get and check the variables in ^DIC(19,+XQY,220)
S XQ220="" S:$D(^DIC(19,+XQY,220)) XQ220=^(220)
I XQ220="" S XQSTXT(XQI)="The expected data in ^DIC(19,"_XQY_",220) is missing.",XQI=XQI+1
S XQJ=100,XQSTXT(XQJ)=" ",XQJ=XQJ+1,XQSTXT(XQJ)="Fields 220 to 225 in the Option File:",XQJ=XQJ+1
S XQB=$P(XQ220,U,1),XQSTXT(XQJ)=$S(XQB="":" 220 - No bulletin selected, will use default XQSERVER",1:" 220 - Bulletin "_$P(^XMB(3.6,XQB,0),U)_" is pointed to."),XQJ=XQJ+1
S XQSA=$P(XQ220,U,2),XQSTXT(XQJ)=" 221 - The server action code is "_$S(XQSA="R":"Run Immediately",XQSA="Q":"Queue Server",XQSA="N":"Notify Mail Group (do not run)",XQSA="I":"Ignore Requests",1:"Missing"),XQJ=XQJ+1
S XQMG=$P(XQ220,U,3),XQSTXT(XQJ)=" 222 - "_$S(XQMG="":"No mail group is pointed to.",1:"The mail group "_$P(^XMB(3.8,XQMG,0),U)_" is pointed to."),XQJ=XQJ+1
S XQAUD=$P(XQ220,U,4),XQSTXT(XQJ)=" 223 - Auditing is turned "_$S(XQAUD="Y":"on",1:"off")_".",XQJ=XQJ+1
S XQSUP=$P(XQ220,U,5),XQSTXT(XQJ)=" 224 - The server's bulletin is "_$S(XQSUP="Y":"",1:"not ")_"supressed.",XQJ=XQJ+1
S XQRPL=$P(XQ220,U,6),XQSTXT(XQJ)=" 225 - Reply mail is "_$S(XQRPL=""!XQRPL="N":"not sent.",XQRPL="E":"sent when an error is trapped.",1:"sent in all cases."),XQJ=XQJ+1
;
BULL ;Check out Bulletins an mail groups, etc.
I XQB="" S XQB=$O(^XMB(3.6,"B","XQSERVER",0)) I XQB="" S XQSTXT(XQI)="No bulletin associated with this option. Default XQSERVER missing from system.",XQI=XQI+1
I XQB,'$D(^XMB(3.6,XQB,0))#2 S XQSTXT(XQI)="Option "_XQSOP_" points to a bulletin not in the Bulletin File.",XQI=XQI+1
I XQMG,'$D(^XMB(3.8,XQMG,0))#2 S XQSTXT(XQI)="Option "_XQSOP_" points to a Mail Group not in Mail Group file."
I XQMG="" F S XQMG=$O(^XMB(3.6,XQB,2,"B",XQMG)) Q:XQMG="" I $D(^XMB(3.8,XQMG,0))#2 S XQ(XQMG)=""
I '$D(XQ),XQMG="" S XQSTXT(XQI)="There are no mail groups associated with the bulletin "_$P(^XMB(3.6,XQB,0),U)_"."
S X=XQB D ^XQSRV4 I Y="" S XQSTXT(XQI)="There is no active user associated with the bulletin "_$P(^XMB(3.6,+XQB,0),U)_"."
I 'XQAUDIT S:$D(^XTV(8989.3,1,19.1,"B",+XQY)) XQAUDIT=1 I XQAUDIT S XQSTART=^XTV(8989.3,1,19),XQEND=$P(XQSTART,U,3),XQSTART=$P(XQSTART,U,2) S:DT<XQSTART!(DT>XQEND) XQAUDIT=0
;
RTN ;Check out the program this server is supposed to run
;S XQMB=$S($D(^XMB(3.6,+XQBUL,0)):$P(^(0),U,1),1:"XQSERVER")
S %="" S:$D(^DIC(19,+XQY,25)) %=^(25) I %="" S XQSTXT(XQI)="There is no routine in field 25 of the Option File for this option.",XQI=XQI+1
I %'="" S X=$S(%[U:$P(%,U,2),1:%) X ^%ZOSF("TEST") I '$T S XQSTXT(XQI)="The routine "_X_" is not on the system.",XQI=XQI+1
;
MODE ;Load, check, and employ Server Action Code
I XQSA="" S XQSTXT(XQI)="There is no Server Action code for this option.",XQI=XQI+1
;
OUT ;Send return message and quit
D SETUP^XQSRV3
K %,%X,X,XQ,XQ220,XQAUD,XQAUDIT,XQB,XQDATE,XQHERE,XQI,XQII,XQJ,XQMB,XQMG,XQMS,XQMSG,XQN,XQRPL,XQSA,XQSCH,XQSND,XQSRV5,XQSTXT,XQSUB,XQSUP,Y
Q
;
CNVT ;Convert %X to uppercase and remove leading spaces
I %X'?.PUN S %X=$$UP^XLFSTR(%X) ;F %I=1:1 Q:%X?.PUN S %Y=$A(%X,%I) I %Y<123,%Y>96 S %X=$E(%X,1,%I-1)_$C(%Y-32)_$E(%X,%I+1,255)
F S %Y=$E(%X,1) Q:%Y'=" " S %X=$E(%X,2,99)
K %I,%Y
Q
XQSRV5 ;MJM/SEA - Check out a server option server;11/9/92 9:54 AM ;01/09/2001 13:32 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**155**;Jul 10, 1995
+3 ;
+4 ;This routine is called by the option XQSCHK. It does various
+5 ;checks on a server option whose name is stored in the first
+6 ;line of message that has activated this program.
+7 ;
+8 ;The variable X contains 4 "^" pieces: OPTION NAME ^ MESSAGE # ^
+9 ;SENDER ^ MESSAGE SUBJECT
+10 ;
+11 ;
START SET XQX=X
SET XQHERE=^XMB("NETNAME")
SET XQI=0
SET XQSRV5=""
SET XQAUDIT=0
+1 DO ^XQDATE
SET XQDATE=%Y
+2 SET XQSTXT(XQI)="This is a reply from: "_XQHERE
SET XQI=XQI+1
+3 SET XQMSG=$PIECE(XQX,U,2)
SET XQSND=$PIECE(XQX,U,3)
SET XQSUB=$PIECE(XQX,U,4,99)
+4 IF '$DATA(XMZ)
SET XMZ=$PIECE(XQX,U,2)
FOR %=1:1:5
XECUTE XMREC
SET %X=XMRG
DO CNVT
SET XMRG=%X
IF XMRG]""!(XMER<0)
QUIT
+5 SET XQSOP=XMRG
IF XMER<0!(XQSOP']"")
SET XQSTXT(XQI)="Can't unload name of server from message: "_XQSUB
SET XQI=XQI+1
GOTO OUT
+6 IF '$TEST
SET XQSTXT(XQI)="Checking server option "_XQSOP_"."
SET XQI=XQI+1
+7 SET XQY=$ORDER(^DIC(19,"B",XQSOP,0))
IF XQY=""
SET XQSTXT(XQI)="The option "_XQSOP_" is not in the Option File."
SET XQI=XQI+1
GOTO OUT
+8 SET XQY0=^DIC(19,XQY,0)
+9 ;
DIC ;Look up option, check it's type and parameters
+1 IF 'XQAUDIT
SET XQN=""
FOR XQII=0:0
SET XQN=$ORDER(^XTV(8989.3,1,19.2,"B",XQN))
IF XQN=""
QUIT
IF ($EXTRACT(XQSOP,1,$LENGTH(XQN))=XQN)
SET XQAUDIT=1
IF XQAUDIT
SET XQSTART=^XTV(8989.3,1,19)
SET XQEND=$PIECE(XQSTART,U,3)
SET XQSTART=$PIECE(XQSTART,U,2)
IF DT<XQSTART!(DT>XQEND)
SET XQAUDIT=0
+2 IF $PIECE(XQY0,U,4)'["S"
SET %=$PIECE(XQY0,U,4)
SET XQSTXT(XQI)="Option "_XQSOP_" is not shown as a server-type option but an "_%_". Should be 'S'."
SET XQI=XQI+1
+3 IF $PIECE(XQY0,U,3)'=""
SET XQSTXT(XQI)=XQSOP_" is marked Out Of Order with the message: "_$PIECE(XQY0,U,3)
SET XQI=XQI+1
+4 ;
XQ220 ;Get and check the variables in ^DIC(19,+XQY,220)
+1 SET XQ220=""
IF $DATA(^DIC(19,+XQY,220))
SET XQ220=^(220)
+2 IF XQ220=""
SET XQSTXT(XQI)="The expected data in ^DIC(19,"_XQY_",220) is missing."
SET XQI=XQI+1
+3 SET XQJ=100
SET XQSTXT(XQJ)=" "
SET XQJ=XQJ+1
SET XQSTXT(XQJ)="Fields 220 to 225 in the Option File:"
SET XQJ=XQJ+1
+4 SET XQB=$PIECE(XQ220,U,1)
SET XQSTXT(XQJ)=$SELECT(XQB="":" 220 - No bulletin selected, will use default XQSERVER",1:" 220 - Bulletin "_$PIECE(^XMB(3.6,XQB,0),U)_" is pointed to.")
SET XQJ=XQJ+1
+5 SET XQSA=$PIECE(XQ220,U,2)
SET XQSTXT(XQJ)=" 221 - The server action code is "_$SELECT(XQSA="R":"Run Immediately",XQSA="Q":"Queue Server",XQSA="N":"Notify Mail Group (do not run)",XQSA="I":"Ignore Requests",1:"Missing")
SET XQJ=XQJ+1
+6 SET XQMG=$PIECE(XQ220,U,3)
SET XQSTXT(XQJ)=" 222 - "_$SELECT(XQMG="":"No mail group is pointed to.",1:"The mail group "_$PIECE(^XMB(3.8,XQMG,0),U)_" is pointed to.")
SET XQJ=XQJ+1
+7 SET XQAUD=$PIECE(XQ220,U,4)
SET XQSTXT(XQJ)=" 223 - Auditing is turned "_$SELECT(XQAUD="Y":"on",1:"off")_"."
SET XQJ=XQJ+1
+8 SET XQSUP=$PIECE(XQ220,U,5)
SET XQSTXT(XQJ)=" 224 - The server's bulletin is "_$SELECT(XQSUP="Y":"",1:"not ")_"supressed."
SET XQJ=XQJ+1
+9 SET XQRPL=$PIECE(XQ220,U,6)
SET XQSTXT(XQJ)=" 225 - Reply mail is "_$SELECT(XQRPL=""!XQRPL="N":"not sent.",XQRPL="E":"sent when an error is trapped.",1:"sent in all cases.")
SET XQJ=XQJ+1
+10 ;
BULL ;Check out Bulletins an mail groups, etc.
+1 IF XQB=""
SET XQB=$ORDER(^XMB(3.6,"B","XQSERVER",0))
IF XQB=""
SET XQSTXT(XQI)="No bulletin associated with this option. Default XQSERVER missing from system."
SET XQI=XQI+1
+2 IF XQB
IF '$DATA(^XMB(3.6,XQB,0))#2
SET XQSTXT(XQI)="Option "_XQSOP_" points to a bulletin not in the Bulletin File."
SET XQI=XQI+1
+3 IF XQMG
IF '$DATA(^XMB(3.8,XQMG,0))#2
SET XQSTXT(XQI)="Option "_XQSOP_" points to a Mail Group not in Mail Group file."
+4 IF XQMG=""
FOR
SET XQMG=$ORDER(^XMB(3.6,XQB,2,"B",XQMG))
IF XQMG=""
QUIT
IF $DATA(^XMB(3.8,XQMG,0))#2
SET XQ(XQMG)=""
+5 IF '$DATA(XQ)
IF XQMG=""
SET XQSTXT(XQI)="There are no mail groups associated with the bulletin "_$PIECE(^XMB(3.6,XQB,0),U)_"."
+6 SET X=XQB
DO ^XQSRV4
IF Y=""
SET XQSTXT(XQI)="There is no active user associated with the bulletin "_$PIECE(^XMB(3.6,+XQB,0),U)_"."
+7 IF 'XQAUDIT
IF $DATA(^XTV(8989.3,1,19.1,"B",+XQY))
SET XQAUDIT=1
IF XQAUDIT
SET XQSTART=^XTV(8989.3,1,19)
SET XQEND=$PIECE(XQSTART,U,3)
SET XQSTART=$PIECE(XQSTART,U,2)
IF DT<XQSTART!(DT>XQEND)
SET XQAUDIT=0
+8 ;
RTN ;Check out the program this server is supposed to run
+1 ;S XQMB=$S($D(^XMB(3.6,+XQBUL,0)):$P(^(0),U,1),1:"XQSERVER")
+2 SET %=""
IF $DATA(^DIC(19,+XQY,25))
SET %=^(25)
IF %=""
SET XQSTXT(XQI)="There is no routine in field 25 of the Option File for this option."
SET XQI=XQI+1
+3 IF %'=""
SET X=$SELECT(%[U:$PIECE(%,U,2),1:%)
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET XQSTXT(XQI)="The routine "_X_" is not on the system."
SET XQI=XQI+1
+4 ;
MODE ;Load, check, and employ Server Action Code
+1 IF XQSA=""
SET XQSTXT(XQI)="There is no Server Action code for this option."
SET XQI=XQI+1
+2 ;
OUT ;Send return message and quit
+1 DO SETUP^XQSRV3
+2 KILL %,%X,X,XQ,XQ220,XQAUD,XQAUDIT,XQB,XQDATE,XQHERE,XQI,XQII,XQJ,XQMB,XQMG,XQMS,XQMSG,XQN,XQRPL,XQSA,XQSCH,XQSND,XQSRV5,XQSTXT,XQSUB,XQSUP,Y
+3 QUIT
+4 ;
CNVT ;Convert %X to uppercase and remove leading spaces
+1 ;F %I=1:1 Q:%X?.PUN S %Y=$A(%X,%I) I %Y<123,%Y>96 S %X=$E(%X,1,%I-1)_$C(%Y-32)_$E(%X,%I+1,255)
IF %X'?.PUN
SET %X=$$UP^XLFSTR(%X)
+2 FOR
SET %Y=$EXTRACT(%X,1)
IF %Y'=" "
QUIT
SET %X=$EXTRACT(%X,2,99)
+3 KILL %I,%Y
+4 QUIT
