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