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

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1XQSRV ;SEA/MJM - Server message processor ;06/13/2003 09:27
2 ;;8.0;KERNEL;**155,308**;Jul 10, 1995
3 Q:'$D(X)#2
4 ;
5 ; 'X' to contain 4 pieces: 1. Name of option, 2. Message number
6 ; 3. Name of sender, and 4-99 The subject of message.
7 ;
8 I $P(X,U)="XQSCHK" D ^XQSRV5 Q ;Server to check out server options
9 I $P(X,U)="XQSPING" S XQSUB=$P(X,U,4,99),XMFROM=$P(X,U,3) D ^XTSPING Q ;PING server
10 ;
11 S U="^",XQX=X,(XQY,XQMSG,XQSND,XQSUB)="Unknown",XQMB="XQSERVER",(XQER,XQER1,XQ220,XQMB6,XQRES)="",(XQAUDIT,XQNOUSR)=0,(XQSUP,XQREPLY,XQMD)="N"
12 S:'$D(DUZ) DUZ=.5 S:(DUZ<.5) DUZ=.5
13 D GETENV^%ZOSV S XQVOL=$P(Y,U,2)
14 S X="ERROR^XQSRV2",@^%ZOSF("TRAP")
15 D ^XQDATE S DT=$P(%,"."),(XQLTL,ZTDTH)=%,XQDATE=%Y
16 S:$D(^XTV(8989.3,1,19.3,"B",+DUZ)) XQAUDIT=1
17 S XQSOP="",XQSOP=$P(XQX,U),XQMSG=$P(XQX,U,2),XQSND=$P(XQX,U,3),XQSUB=$P(XQX,U,4,99) I '$D(XMFROM) S XMFROM=XQSND
18 I XQSOP'?.PUN S XQSOP=$$UP^XLFSTR(XQSOP) ;F XQI=1:1 Q:XQSOP?.PUN S XQX=$A(XQSOP,XQI) I XQX<123,XQX>96 S XQSOP=$E(XQSOP,1,XQI-1)_$C(XQX-32)_$E(XQSOP,XQI+1,255)
19 I XQSOP="?" S XQER=$T(7)_" "_$P(X,U)
20 I 'XQAUDIT S XQCHK="XQSRV",XQN="" D
21 .F S XQN=$O(^XTV(8989.3,1,19.2,"B",XQN)) Q:XQN="" S:($E(XQCHK,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
22 .Q
23 I '$L(XQSOP)!(XQSOP'?3.30UNP) S XQER=$T(1)_" "_XQSOP,XQAUDIT=1 G OUT
24 ;
25DIC ;Look up option, check it's type and parameters
26 S X=XQSOP,DIC=19,DIC(0)="MFXZ" D ^DIC I Y<0 S XQER=$T(4)_" "_XQSOP,XQAUDIT=1 G OUT
27 I 'XQAUDIT S XQN="" F XQI=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
28 S XQY=+Y,XQY0=Y(0) I $P(XQY0,U,4)'["S" S XQER=$T(5)_" "_XQSOP G OUT
29 I $P(XQY0,U,3)'="" S XQER="Out of Order: "_$P(XQY0,U,3) G OUT
30 S XQ220="" S:$D(^DIC(19,+XQY,220)) XQ220=^(220)
31 S XQSUP=$P(XQ220,U,5),XQREPLY=$P(XQ220,U,6)
32 I XQSUP'="Y" S X=$P(XQ220,U,1) D ^XQSRV4 I Y="" S (XQAUDIT,XQNOUSR)=1,XQER=$T(10)_" "_XQMB
33 S XQBUL=$S(XQNOUSR:0,1:XQMB)
34 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
35 S:$P(XQ220,U,4)["Y" XQAUDIT=1
36 ;
37CHK ;Finish checking this request out
38 I '$L(XQMSG)!(XQMSG'=+XQMSG) S XQER=$T(2)_" "_XQMSG G OUT
39 I '$D(^XMB(3.9,+XQMSG)) S XQER=$T(6)_" "_XQMSG G OUT
40 ;
41MODE ;Load, check, and employ Server Action Code
42 S XQMD=$P(XQ220,U,2) I XQMD="" S XQER=$T(9)_XQSOP G OUT
43 I XQMD="I" S XQER="Request for "_XQSOP_" ignored.",XQER1=" No action taken." G OUT
44 G:$L(XQER) OUT
45 ;
46 G ^XQSRV1
47 ;
48OUT ;Do audit, bulletin (& reply mail), and no-user bulletin.
49 D:XQAUDIT AUDIT^XQSRV1,AUDIT^XQSRV2
50 G OUT^XQSRV2
51 Q
52 ;
53MESS ;Returned in bulletins with bad parameters
541 ;;Invalid server option name specified:
552 ;;Invalid message number specified:
563 ;;Invalid message subject field specified:
574 ;;No such server option in the Option File:
585 ;;Requested option is not a server option:
596 ;;No such message number in the Message File (^XMB(3.9)):
607 ;;Invalid option name, imbedded control characters in option:
618 ;;The bulletin pointed to by this server is not in the Bulletin File (^XMB(3.6)):
629 ;;No server action code in Option File for:
6310 ;;Security Violation: No active user or mail group connected to bulletin:
64 Q
Note: See TracBrowser for help on using the repository browser.