source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSRV5.m@ 949

Last change on this file since 949 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1XQSRV5 ;MJM/SEA - Check out a server option server;11/9/92 9:54 AM ;01/09/2001 13:32
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 ;
12START S XQX=X,XQHERE=^XMB("NETNAME"),XQI=0,XQSRV5="",XQAUDIT=0
13 D ^XQDATE S XQDATE=%Y
14 S XQSTXT(XQI)="This is a reply from: "_XQHERE,XQI=XQI+1
15 S XQMSG=$P(XQX,U,2),XQSND=$P(XQX,U,3),XQSUB=$P(XQX,U,4,99)
16 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)
17 S XQSOP=XMRG I XMER<0!(XQSOP']"") S XQSTXT(XQI)="Can't unload name of server from message: "_XQSUB,XQI=XQI+1 G OUT
18 E S XQSTXT(XQI)="Checking server option "_XQSOP_".",XQI=XQI+1
19 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
20 S XQY0=^DIC(19,XQY,0)
21 ;
22DIC ;Look up option, check it's type and parameters
23 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
24 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
25 I $P(XQY0,U,3)'="" S XQSTXT(XQI)=XQSOP_" is marked Out Of Order with the message: "_$P(XQY0,U,3),XQI=XQI+1
26 ;
27XQ220 ;Get and check the variables in ^DIC(19,+XQY,220)
28 S XQ220="" S:$D(^DIC(19,+XQY,220)) XQ220=^(220)
29 I XQ220="" S XQSTXT(XQI)="The expected data in ^DIC(19,"_XQY_",220) is missing.",XQI=XQI+1
30 S XQJ=100,XQSTXT(XQJ)=" ",XQJ=XQJ+1,XQSTXT(XQJ)="Fields 220 to 225 in the Option File:",XQJ=XQJ+1
31 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
32 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
33 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
34 S XQAUD=$P(XQ220,U,4),XQSTXT(XQJ)=" 223 - Auditing is turned "_$S(XQAUD="Y":"on",1:"off")_".",XQJ=XQJ+1
35 S XQSUP=$P(XQ220,U,5),XQSTXT(XQJ)=" 224 - The server's bulletin is "_$S(XQSUP="Y":"",1:"not ")_"supressed.",XQJ=XQJ+1
36 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
37 ;
38BULL ;Check out Bulletins an mail groups, etc.
39 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
40 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
41 I XQMG,'$D(^XMB(3.8,XQMG,0))#2 S XQSTXT(XQI)="Option "_XQSOP_" points to a Mail Group not in Mail Group file."
42 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)=""
43 I '$D(XQ),XQMG="" S XQSTXT(XQI)="There are no mail groups associated with the bulletin "_$P(^XMB(3.6,XQB,0),U)_"."
44 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)_"."
45 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
46 ;
47RTN ;Check out the program this server is supposed to run
48 ;S XQMB=$S($D(^XMB(3.6,+XQBUL,0)):$P(^(0),U,1),1:"XQSERVER")
49 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
50 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
51 ;
52MODE ;Load, check, and employ Server Action Code
53 I XQSA="" S XQSTXT(XQI)="There is no Server Action code for this option.",XQI=XQI+1
54 ;
55OUT ;Send return message and quit
56 D SETUP^XQSRV3
57 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
58 Q
59 ;
60CNVT ;Convert %X to uppercase and remove leading spaces
61 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)
62 F S %Y=$E(%X,1) Q:%Y'=" " S %X=$E(%X,2,99)
63 K %I,%Y
64 Q
Note: See TracBrowser for help on using the repository browser.