- XQSRV ;SEA/MJM - Server message processor ;06/13/2003 09:27
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSRV 3469 printed Feb 18, 2025@23:33:05 Page 2
- XQSRV ;SEA/MJM - Server message processor ;06/13/2003 09:27
- +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