source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQSRV1.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1XQSRV1 ;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 ;
15TASK ;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 ;
34OUT ;Trigger the bulletin, do the audit, and split.
35 D:XQAUDIT AUDIT,AUDIT^XQSRV2
36 G OUT^XQSRV2
37 Q
38 ;
39AUDIT ;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 ;
47REQUE ; 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
Note: See TracBrowser for help on using the repository browser.