- XQSRV5 ;MJM/SEA - Check out a server option server;11/9/92 9:54 AM ;01/09/2001 13:32
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSRV5 4809 printed Feb 18, 2025@23:33:09 Page 2
- XQSRV5 ;MJM/SEA - Check out a server option server;11/9/92 9:54 AM ;01/09/2001 13:32
- +1 ;;8.0;KERNEL;**155**;Jul 10, 1995
- +2 ;
- +3 ;This routine is called by the option XQSCHK. It does various
- +4 ;checks on a server option whose name is stored in the first
- +5 ;line of message that has activated this program.
- +6 ;
- +7 ;The variable X contains 4 "^" pieces: OPTION NAME ^ MESSAGE # ^
- +8 ;SENDER ^ MESSAGE SUBJECT
- +9 ;
- +10 ;
- 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