- XQSRV1 ;SEA/MJM - Server option utilities ;10/15/96 13:14
- ;;8.0;KERNEL;**50**;Jul 10, 1995
- ;
- ;File the message in POSTMASTER'S mailbox of option's name
- S XQSRV=$P(XQ220,U,7) S:XQSRV="" XQSRV=1
- I XQSRV S XMXX="S."_XQSOP,XMZ=XQMSG D SETSB^XMA1C
- ;
- ;Check for a resource
- S XQRES=$P(XQ220,U,8) I XQRES'="",($D(^%ZIS(1,XQRES,0))) S XQRES=$P(^(0),U)
- E S XQRES=""
- ;
- I $D(XMFROM),XMFROM=+XMFROM,$D(^VA(200,+XMFROM,0)) S XMFROM=$P(^(0),U)
- I XQSUB["~U~" F XQI=0:0 Q:XQSUB'["~U~" S XQSUB=$P(XQSUB,"~U~")_"^"_$P(XQSUB,"~U~",2,99)
- ;
- TASK ;Set up task parameters and call Taskman
- S XQRTN="" S:$D(^DIC(19,+XQY,25)) XQRTN=^(25) S:XQRTN'["^" XQRTN="^"_XQRTN
- ;I XQMD="R"&'($D(^DIC(19,XQY,3.91,0))&($P(^(0),U,4)>0)) S X=$P(XQY0,U,8) X:$L(X) ^%ZOSF("PRIORITY") G ZTSK^XQSRV2 ;Just go do it!
- I XQMD="R"&'($P($G(^DIC(19,XQY,3.91,0)),U,4)>0) S X=$P(XQY0,U,8) X:$L(X) ^%ZOSF("PRIORITY") G ZTSK^XQSRV2
- I XQMD="R" S XQMD="Q" ;Must be queued if days/times are restricted
- ;
- S ZTPRI=$P(XQY0,U,8),ZTRTN="ZTSK^XQSRV2",ZTDESC="Server Request: "_$P(XQY0,U,2)_" Message #: "_XQMSG,ZTIO=XQRES
- S XQDAYS=$P(XQ220,U,9) S:(XQDAYS'>0) XQDAYS=14 S ZTKIL=$P($H,",")+XQDAYS_",00000" ;Retention time to save task in ZTSK
- S ZTSAVE("XQY")="",ZTSAVE("XQY0")="",ZTSAVE("XQ220")="",ZTSAVE("XQLTL")="",ZTSAVE("XQAUDIT")="",ZTSAVE("XQREPLY")="",ZTSAVE("XQSUP")="",ZTSAVE("XQNOUSR")=""
- S ZTSAVE("XQMSG")="",ZTSAVE("XQSUB")="",ZTSAVE("XQSND")="",ZTSAVE("XQRTN")="",ZTSAVE("XQSOP")="",ZTSAVE("XQMD")="",ZTSAVE("XQDATE")="",ZTSAVE("XQMB6")="",ZTSAVE("XQMB")=""
- S ZTSAVE("XMREC")="",ZTSAVE("XMFROM")="",ZTSAVE("XMCHAN")="",ZTSAVE("XMXX")="",ZTSAVE("XMZ")=""
- ;
- I XQMD="N" S ZTDTH=$H+2_",0" D ^%ZTLOAD,XQ^XUTMT S XQMB6="Server request for "_XQSOP_". Task # "_ZTSK_" needs to be scheduled." G OUT
- I XQMD="Q" S X=XQLTL D
- .N Y S Y=+XQY D NEXT^XQ92 S XQX=X
- .I XQX="" S XQER="Scheduling Error: All days and times for the option "_XQSOP_" are prohibited."
- .I XQX'="" S (ZTDTH,XQDTH)=X D ^%ZTLOAD S XQMB6="Server request queued for "_XQDTH_" task # "_ZTSK
- G:(XQX'="") KILL^XQSRV2
- ;
- OUT ;Trigger the bulletin, do the audit, and split.
- D:XQAUDIT AUDIT,AUDIT^XQSRV2
- G OUT^XQSRV2
- Q
- ;
- AUDIT ;Enter the option audit data in Audit Log for Option File
- D GETENV^%ZOSV S XQVOL=$P(Y,U,2)
- F XQI=0:0 S XQLTL=XQLTL+.0000001 I '$D(^XUSEC(19,XQLTL,0))#2 L +^XUSEC(19,0) S $P(^(0),U,3,4)=XQLTL_"^"_($P(^XUSEC(19,0),U,4)+1) L -^XUSEC(19,0) Q
- S ^XUSEC(19,XQLTL,0)=XQY_U_DUZ_U_$I_U_$J_U_U_XQVOL
- S ^XUSEC(19,XQLTL,1)=XQMSG_U_XMFROM
- S ^XUSEC(19,XQLTL,2)=XQSUB
- Q
- ;
- REQUE ; Requeue a server option not previously queued due to some problem
- R !,"Message Number of Server message: ",XQMSG:DTIME Q:'$T!(XQMSG="")!(XQMSG[U)!(XQMSG'>0)
- I '$D(^XMB(3.9,XQMSG)) W !,$C(7),"Invalid MESSAGE NUMBER",! G REQUE
- F I=0:0 S I=$O(^XMB(3.9,XQMSG,1,I)) Q:I'>0 S XQ=^(I,0) I "S.s."[$E(XQ,1,2) S XQ=$P(XQ,U,1) Q
- I "S.s."'[$E(XQ,1,2) W !,$C(7),"MESSAGE is NOT a SERVER MESSAGE",! G REQUE
- S %DT="AET",%DT("A")="Date/time to run server program: ",%DT("B")="NOW" D ^%DT I Y>0 S ZTDTH=Y
- S X=$E(XQ,3,$L(XQ))_U_XQMSG S I=$P(^XMB(3.9,XQMSG,0),U,2),X=X_U_$S(I'>0:I,'$D(^VA(200,+I,0)):"UNKNOWN",1:$P(^(0),U,1))_U_$P(^XMB(3.9,XQMSG,0),U,1)
- G ^XQSRV
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQSRV1 3237 printed Feb 18, 2025@23:33:06 Page 2
- XQSRV1 ;SEA/MJM - Server option utilities ;10/15/96 13:14
- +1 ;;8.0;KERNEL;**50**;Jul 10, 1995
- +2 ;
- +3 ;File the message in POSTMASTER'S mailbox of option's name
- +4 SET XQSRV=$PIECE(XQ220,U,7)
- if XQSRV=""
- SET XQSRV=1
- +5 IF XQSRV
- SET XMXX="S."_XQSOP
- SET XMZ=XQMSG
- DO SETSB^XMA1C
- +6 ;
- +7 ;Check for a resource
- +8 SET XQRES=$PIECE(XQ220,U,8)
- IF XQRES'=""
- IF ($DATA(^%ZIS(1,XQRES,0)))
- SET XQRES=$PIECE(^(0),U)
- +9 IF '$TEST
- SET XQRES=""
- +10 ;
- +11 IF $DATA(XMFROM)
- IF XMFROM=+XMFROM
- IF $DATA(^VA(200,+XMFROM,0))
- SET XMFROM=$PIECE(^(0),U)
- +12 IF XQSUB["~U~"
- FOR XQI=0:0
- if XQSUB'["~U~"
- QUIT
- SET XQSUB=$PIECE(XQSUB,"~U~")_"^"_$PIECE(XQSUB,"~U~",2,99)
- +13 ;
- TASK ;Set up task parameters and call Taskman
- +1 SET XQRTN=""
- if $DATA(^DIC(19,+XQY,25))
- SET XQRTN=^(25)
- if XQRTN'["^"
- SET XQRTN="^"_XQRTN
- +2 ;I XQMD="R"&'($D(^DIC(19,XQY,3.91,0))&($P(^(0),U,4)>0)) S X=$P(XQY0,U,8) X:$L(X) ^%ZOSF("PRIORITY") G ZTSK^XQSRV2 ;Just go do it!
- +3 IF XQMD="R"&'($PIECE($GET(^DIC(19,XQY,3.91,0)),U,4)>0)
- SET X=$PIECE(XQY0,U,8)
- if $LENGTH(X)
- XECUTE ^%ZOSF("PRIORITY")
- GOTO ZTSK^XQSRV2
- +4 ;Must be queued if days/times are restricted
- IF XQMD="R"
- SET XQMD="Q"
- +5 ;
- +6 SET ZTPRI=$PIECE(XQY0,U,8)
- SET ZTRTN="ZTSK^XQSRV2"
- SET ZTDESC="Server Request: "_$PIECE(XQY0,U,2)_" Message #: "_XQMSG
- SET ZTIO=XQRES
- +7 ;Retention time to save task in ZTSK
- SET XQDAYS=$PIECE(XQ220,U,9)
- if (XQDAYS'>0)
- SET XQDAYS=14
- SET ZTKIL=$PIECE($HOROLOG,",")+XQDAYS_",00000"
- +8 SET ZTSAVE("XQY")=""
- SET ZTSAVE("XQY0")=""
- SET ZTSAVE("XQ220")=""
- SET ZTSAVE("XQLTL")=""
- SET ZTSAVE("XQAUDIT")=""
- SET ZTSAVE("XQREPLY")=""
- SET ZTSAVE("XQSUP")=""
- SET ZTSAVE("XQNOUSR")=""
- +9 SET ZTSAVE("XQMSG")=""
- SET ZTSAVE("XQSUB")=""
- SET ZTSAVE("XQSND")=""
- SET ZTSAVE("XQRTN")=""
- SET ZTSAVE("XQSOP")=""
- SET ZTSAVE("XQMD")=""
- SET ZTSAVE("XQDATE")=""
- SET ZTSAVE("XQMB6")=""
- SET ZTSAVE("XQMB")=""
- +10 SET ZTSAVE("XMREC")=""
- SET ZTSAVE("XMFROM")=""
- SET ZTSAVE("XMCHAN")=""
- SET ZTSAVE("XMXX")=""
- SET ZTSAVE("XMZ")=""
- +11 ;
- +12 IF XQMD="N"
- SET ZTDTH=$HOROLOG+2_",0"
- DO ^%ZTLOAD
- DO XQ^XUTMT
- SET XQMB6="Server request for "_XQSOP_". Task # "_ZTSK_" needs to be scheduled."
- GOTO OUT
- +13 IF XQMD="Q"
- SET X=XQLTL
- Begin DoDot:1
- +14 NEW Y
- SET Y=+XQY
- DO NEXT^XQ92
- SET XQX=X
- +15 IF XQX=""
- SET XQER="Scheduling Error: All days and times for the option "_XQSOP_" are prohibited."
- +16 IF XQX'=""
- SET (ZTDTH,XQDTH)=X
- DO ^%ZTLOAD
- SET XQMB6="Server request queued for "_XQDTH_" task # "_ZTSK
- End DoDot:1
- +17 if (XQX'="")
- GOTO KILL^XQSRV2
- +18 ;
- OUT ;Trigger the bulletin, do the audit, and split.
- +1 if XQAUDIT
- DO AUDIT
- DO AUDIT^XQSRV2
- +2 GOTO OUT^XQSRV2
- +3 QUIT
- +4 ;
- AUDIT ;Enter the option audit data in Audit Log for Option File
- +1 DO GETENV^%ZOSV
- SET XQVOL=$PIECE(Y,U,2)
- +2 FOR XQI=0:0
- SET XQLTL=XQLTL+.0000001
- IF '$DATA(^XUSEC(19,XQLTL,0))#2
- LOCK +^XUSEC(19,0)
- SET $PIECE(^(0),U,3,4)=XQLTL_"^"_($PIECE(^XUSEC(19,0),U,4)+1)
- LOCK -^XUSEC(19,0)
- QUIT
- +3 SET ^XUSEC(19,XQLTL,0)=XQY_U_DUZ_U_$IO_U_$JOB_U_U_XQVOL
- +4 SET ^XUSEC(19,XQLTL,1)=XQMSG_U_XMFROM
- +5 SET ^XUSEC(19,XQLTL,2)=XQSUB
- +6 QUIT
- +7 ;
- REQUE ; Requeue a server option not previously queued due to some problem
- +1 READ !,"Message Number of Server message: ",XQMSG:DTIME
- if '$TEST!(XQMSG="")!(XQMSG[U)!(XQMSG'>0)
- QUIT
- +2 IF '$DATA(^XMB(3.9,XQMSG))
- WRITE !,$CHAR(7),"Invalid MESSAGE NUMBER",!
- GOTO REQUE
- +3 FOR I=0:0
- SET I=$ORDER(^XMB(3.9,XQMSG,1,I))
- if I'>0
- QUIT
- SET XQ=^(I,0)
- IF "S.s."[$EXTRACT(XQ,1,2)
- SET XQ=$PIECE(XQ,U,1)
- QUIT
- +4 IF "S.s."'[$EXTRACT(XQ,1,2)
- WRITE !,$CHAR(7),"MESSAGE is NOT a SERVER MESSAGE",!
- GOTO REQUE
- +5 SET %DT="AET"
- SET %DT("A")="Date/time to run server program: "
- SET %DT("B")="NOW"
- DO ^%DT
- IF Y>0
- SET ZTDTH=Y
- +6 SET X=$EXTRACT(XQ,3,$LENGTH(XQ))_U_XQMSG
- SET I=$PIECE(^XMB(3.9,XQMSG,0),U,2)
- SET X=X_U_$SELECT(I'>0:I,'$DATA(^VA(200,+I,0)):"UNKNOWN",1:$PIECE(^(0),U,1))_U_$PIECE(^XMB(3.9,XQMSG,0),U,1)
- +7 GOTO ^XQSRV