Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XQSRV

XQSRV.m

Go to the documentation of this file.
  1. XQSRV ;SEA/MJM - Server message processor ;06/13/2003 09:27
  1. ;;8.0;KERNEL;**155,308**;Jul 10, 1995
  1. Q:'$D(X)#2
  1. ;
  1. ; 'X' to contain 4 pieces: 1. Name of option, 2. Message number
  1. ; 3. Name of sender, and 4-99 The subject of message.
  1. ;
  1. I $P(X,U)="XQSCHK" D ^XQSRV5 Q ;Server to check out server options
  1. I $P(X,U)="XQSPING" S XQSUB=$P(X,U,4,99),XMFROM=$P(X,U,3) D ^XTSPING Q ;PING server
  1. ;
  1. S U="^",XQX=X,(XQY,XQMSG,XQSND,XQSUB)="Unknown",XQMB="XQSERVER",(XQER,XQER1,XQ220,XQMB6,XQRES)="",(XQAUDIT,XQNOUSR)=0,(XQSUP,XQREPLY,XQMD)="N"
  1. S:'$D(DUZ) DUZ=.5 S:(DUZ<.5) DUZ=.5
  1. D GETENV^%ZOSV S XQVOL=$P(Y,U,2)
  1. S X="ERROR^XQSRV2",@^%ZOSF("TRAP")
  1. D ^XQDATE S DT=$P(%,"."),(XQLTL,ZTDTH)=%,XQDATE=%Y
  1. S:$D(^XTV(8989.3,1,19.3,"B",+DUZ)) XQAUDIT=1
  1. 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
  1. 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)
  1. I XQSOP="?" S XQER=$T(7)_" "_$P(X,U)
  1. I 'XQAUDIT S XQCHK="XQSRV",XQN="" D
  1. .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
  1. .Q
  1. I '$L(XQSOP)!(XQSOP'?3.30UNP) S XQER=$T(1)_" "_XQSOP,XQAUDIT=1 G OUT
  1. ;
  1. DIC ;Look up option, check it's type and parameters
  1. S X=XQSOP,DIC=19,DIC(0)="MFXZ" D ^DIC I Y<0 S XQER=$T(4)_" "_XQSOP,XQAUDIT=1 G OUT
  1. 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
  1. S XQY=+Y,XQY0=Y(0) I $P(XQY0,U,4)'["S" S XQER=$T(5)_" "_XQSOP G OUT
  1. I $P(XQY0,U,3)'="" S XQER="Out of Order: "_$P(XQY0,U,3) G OUT
  1. S XQ220="" S:$D(^DIC(19,+XQY,220)) XQ220=^(220)
  1. S XQSUP=$P(XQ220,U,5),XQREPLY=$P(XQ220,U,6)
  1. I XQSUP'="Y" S X=$P(XQ220,U,1) D ^XQSRV4 I Y="" S (XQAUDIT,XQNOUSR)=1,XQER=$T(10)_" "_XQMB
  1. S XQBUL=$S(XQNOUSR:0,1:XQMB)
  1. 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
  1. S:$P(XQ220,U,4)["Y" XQAUDIT=1
  1. ;
  1. CHK ;Finish checking this request out
  1. I '$L(XQMSG)!(XQMSG'=+XQMSG) S XQER=$T(2)_" "_XQMSG G OUT
  1. I '$D(^XMB(3.9,+XQMSG)) S XQER=$T(6)_" "_XQMSG G OUT
  1. ;
  1. MODE ;Load, check, and employ Server Action Code
  1. S XQMD=$P(XQ220,U,2) I XQMD="" S XQER=$T(9)_XQSOP G OUT
  1. I XQMD="I" S XQER="Request for "_XQSOP_" ignored.",XQER1=" No action taken." G OUT
  1. G:$L(XQER) OUT
  1. ;
  1. G ^XQSRV1
  1. ;
  1. OUT ;Do audit, bulletin (& reply mail), and no-user bulletin.
  1. D:XQAUDIT AUDIT^XQSRV1,AUDIT^XQSRV2
  1. G OUT^XQSRV2
  1. Q
  1. ;
  1. MESS ;Returned in bulletins with bad parameters
  1. 1 ;;Invalid server option name specified:
  1. 2 ;;Invalid message number specified:
  1. 3 ;;Invalid message subject field specified:
  1. 4 ;;No such server option in the Option File:
  1. 5 ;;Requested option is not a server option:
  1. 6 ;;No such message number in the Message File (^XMB(3.9)):
  1. 7 ;;Invalid option name, imbedded control characters in option:
  1. 8 ;;The bulletin pointed to by this server is not in the Bulletin File (^XMB(3.6)):
  1. 9 ;;No server action code in Option File for:
  1. 10 ;;Security Violation: No active user or mail group connected to bulletin:
  1. Q