| 1 | XQSRV1 ;SEA/MJM - Server option utilities ;10/15/96 13:14
|
|---|
| 2 | ;;8.0;KERNEL;**50**;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;File the message in POSTMASTER'S mailbox of option's name
|
|---|
| 5 | S XQSRV=$P(XQ220,U,7) S:XQSRV="" XQSRV=1
|
|---|
| 6 | I XQSRV S XMXX="S."_XQSOP,XMZ=XQMSG D SETSB^XMA1C
|
|---|
| 7 | ;
|
|---|
| 8 | ;Check for a resource
|
|---|
| 9 | S XQRES=$P(XQ220,U,8) I XQRES'="",($D(^%ZIS(1,XQRES,0))) S XQRES=$P(^(0),U)
|
|---|
| 10 | E S XQRES=""
|
|---|
| 11 | ;
|
|---|
| 12 | I $D(XMFROM),XMFROM=+XMFROM,$D(^VA(200,+XMFROM,0)) S XMFROM=$P(^(0),U)
|
|---|
| 13 | I XQSUB["~U~" F XQI=0:0 Q:XQSUB'["~U~" S XQSUB=$P(XQSUB,"~U~")_"^"_$P(XQSUB,"~U~",2,99)
|
|---|
| 14 | ;
|
|---|
| 15 | TASK ;Set up task parameters and call Taskman
|
|---|
| 16 | S XQRTN="" S:$D(^DIC(19,+XQY,25)) XQRTN=^(25) S:XQRTN'["^" XQRTN="^"_XQRTN
|
|---|
| 17 | ;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!
|
|---|
| 18 | 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
|
|---|
| 19 | I XQMD="R" S XQMD="Q" ;Must be queued if days/times are restricted
|
|---|
| 20 | ;
|
|---|
| 21 | S ZTPRI=$P(XQY0,U,8),ZTRTN="ZTSK^XQSRV2",ZTDESC="Server Request: "_$P(XQY0,U,2)_" Message #: "_XQMSG,ZTIO=XQRES
|
|---|
| 22 | S XQDAYS=$P(XQ220,U,9) S:(XQDAYS'>0) XQDAYS=14 S ZTKIL=$P($H,",")+XQDAYS_",00000" ;Retention time to save task in ZTSK
|
|---|
| 23 | S ZTSAVE("XQY")="",ZTSAVE("XQY0")="",ZTSAVE("XQ220")="",ZTSAVE("XQLTL")="",ZTSAVE("XQAUDIT")="",ZTSAVE("XQREPLY")="",ZTSAVE("XQSUP")="",ZTSAVE("XQNOUSR")=""
|
|---|
| 24 | S ZTSAVE("XQMSG")="",ZTSAVE("XQSUB")="",ZTSAVE("XQSND")="",ZTSAVE("XQRTN")="",ZTSAVE("XQSOP")="",ZTSAVE("XQMD")="",ZTSAVE("XQDATE")="",ZTSAVE("XQMB6")="",ZTSAVE("XQMB")=""
|
|---|
| 25 | S ZTSAVE("XMREC")="",ZTSAVE("XMFROM")="",ZTSAVE("XMCHAN")="",ZTSAVE("XMXX")="",ZTSAVE("XMZ")=""
|
|---|
| 26 | ;
|
|---|
| 27 | 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
|
|---|
| 28 | I XQMD="Q" S X=XQLTL D
|
|---|
| 29 | .N Y S Y=+XQY D NEXT^XQ92 S XQX=X
|
|---|
| 30 | .I XQX="" S XQER="Scheduling Error: All days and times for the option "_XQSOP_" are prohibited."
|
|---|
| 31 | .I XQX'="" S (ZTDTH,XQDTH)=X D ^%ZTLOAD S XQMB6="Server request queued for "_XQDTH_" task # "_ZTSK
|
|---|
| 32 | G:(XQX'="") KILL^XQSRV2
|
|---|
| 33 | ;
|
|---|
| 34 | OUT ;Trigger the bulletin, do the audit, and split.
|
|---|
| 35 | D:XQAUDIT AUDIT,AUDIT^XQSRV2
|
|---|
| 36 | G OUT^XQSRV2
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | AUDIT ;Enter the option audit data in Audit Log for Option File
|
|---|
| 40 | D GETENV^%ZOSV S XQVOL=$P(Y,U,2)
|
|---|
| 41 | 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
|
|---|
| 42 | S ^XUSEC(19,XQLTL,0)=XQY_U_DUZ_U_$I_U_$J_U_U_XQVOL
|
|---|
| 43 | S ^XUSEC(19,XQLTL,1)=XQMSG_U_XMFROM
|
|---|
| 44 | S ^XUSEC(19,XQLTL,2)=XQSUB
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | REQUE ; Requeue a server option not previously queued due to some problem
|
|---|
| 48 | R !,"Message Number of Server message: ",XQMSG:DTIME Q:'$T!(XQMSG="")!(XQMSG[U)!(XQMSG'>0)
|
|---|
| 49 | I '$D(^XMB(3.9,XQMSG)) W !,$C(7),"Invalid MESSAGE NUMBER",! G REQUE
|
|---|
| 50 | 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
|
|---|
| 51 | I "S.s."'[$E(XQ,1,2) W !,$C(7),"MESSAGE is NOT a SERVER MESSAGE",! G REQUE
|
|---|
| 52 | S %DT="AET",%DT("A")="Date/time to run server program: ",%DT("B")="NOW" D ^%DT I Y>0 S ZTDTH=Y
|
|---|
| 53 | 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)
|
|---|
| 54 | G ^XQSRV
|
|---|
