source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQALFWD.m@ 701

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1XQALFWD ;ISC-SF.SEA/JLI - FORWARD ALERTS ;7/24/03 16:27
2 ;;8.0;KERNEL;**6,65,91,111,114,128,129,285**;Jul 10, 1995
3 Q
4FWRD ; ENTRY POINT FOR SELECTION FROM 'VIEW ALERTS' SCREEN
5 ; USER NEEDS TO SELECT ALERT(S) FOR FORWARDING
6 ; TYPE (ALERT, MAIL MESSAGE, OR PRINT)
7 ; AND RECIPIENT(S) OR DEVICE
8 ; AND COMMENT IF ANY TO BE DISPLAYED WITH ALERT
9 ;
10 W !,"Enter RETURN to continue:" R X:DTIME Q:'$T W @IOF,!,"You may now Select the alert or alerts that you want forwarded:",!
11 N XQI,XQK,XQACNT,XQAREV,DIR
12 S XQALFWD=1 S XQX1=-1 D DOIT^XQALERT1
13 K XQALFWDL
14 S:'$D(XQX1) XQX1=-1 S:'$D(XQXOUT) XQXOUT=0
15 F Q:XQX1'>0 S XQALFWDL(+XQX1)=$P(^TMP("XQ",$J,"XQA1",+XQX1),U,2),XQX1=$P(XQX1,",",2,200)
16 G:'$D(XQALFWDL) EXIT
17FWDONE K DIR S DIR(0)="S^A:ALERT;M:MAIL MESSAGE;P:PRINT COPY;",DIR("A")="Select the method of forwarding desired",DIR("B")="ALERT" D ^DIR K DIR G:$D(DIRUT) EXIT S XQATYP=Y
18 I XQATYP="A"!(XQATYP="M") D LOOP1^XQALMAKE G:'$D(XQA) EXIT N XQAI S XQAI="" F S XQAI=$O(XQA(XQAI)) Q:XQAI="" S XQAARR(XQAI)=XQAI K XQA(XQAI)
19 I XQATYP="P" S DIC=3.5,DIC(0)="AEQM",DIC("A")="Select the DEVICE to print on: " D ^DIC K DIC G:Y'>0 EXIT S XQAARR="`"_(+Y)
20 S DIR("A",1)="You may enter a comment to be associated with the forwarded alert if you wish",DIR("A")="Comment (optional)",DIR("?")="Free text 1 to 245 characters.",DIR(0)="FO^1:245"
21 D ^DIR G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) EXIT S XQACOMNT=X
22 K XQALFWD,DIR
23 D FORWARD(.XQALFWDL,.XQAARR,XQATYP,XQACOMNT)
24EXIT S XQX1=-1 W !!,"You will now return to PROCESSING ALERTS, enter RETURN to continue:" R X:DTIME
25 K XQALFWDL,XQAARR,XQATYP,XQACOMNT,DIRUT,XQALFWD
26 Q
27 ;
28FORWARD1(XQAID,XQARECIP,XQATYPE,XQACOMNT,XQALTYPE) ;
29 D FORWARD(.XQAID,XQARECIP,XQATYPE,XQACOMNT)
30 Q
31 ;
32FORWARD(XQALST,XQARECIP,XQATYPE,XQACOMNT) ;
33 Q:'$D(XQALST) Q:'$D(XQARECIP)
34 N I,XQAVALS,XQALTYPE
35 S XQALTYPE="FWD BY USER"
36 S XQATYPE=$G(XQATYPE)
37 I XQATYPE="A" D
38 . N XQAI S XQAI="" F S XQAI=$O(XQALST(XQAI)) Q:XQAI="" D SETXQA D RESETUP(XQALST(XQAI),.XQAVALS,XQACOMNT)
39 . I $O(XQALST(""))="",$D(XQALST)=1,XQALST'="" D SETXQA D RESETUP(XQALST,.XQAVALS,XQACOMNT)
40 I XQATYPE="M" D
41 . D MAIL1
42 I XQATYPE="P" D
43 . S IOP=XQAARR D ^%ZIS Q:POP
44 . D PRNT D ^%ZISC
45 Q
46 ;
47SETXQA ;
48 I $D(XQARECIP)=1 S XQAVALS(XQARECIP)="" Q
49 S J="" F S J=$O(XQARECIP(J)) Q:J="" S XQAVALS(XQARECIP(J))=""
50 Q
51 ;
52SETXMY ;
53 I $D(XQARECIP)=1 S XMY(XQARECIP)="" Q
54 S J="" F S J=$O(XQARECIP(J)) Q:J="" S XMY(XQARECIP(J))=""
55 Q
56 ;
57MAIL1 ;
58 N I,XMY,XMSUB,XMTEXT
59 N XQAI S XQAI="" F S XQAI=$O(XQALST(XQAI)) Q:XQAI="" S X=$O(^XTV(8992,"AXQA",XQALST(XQAI),XQAUSER,0)) I X'="" S X=$G(^XTV(8992,XQAUSER,"XQA",X,0)) I X'="" D SETXMY D MAIL
60 I $D(XQALST)=1,XQALST]"" S X=$O(^XTV(8992,"AXQA",XQALST,XQAUSER,0)) I X'="" S X=$G(^XTV(8992,XQAUSER,"XQA",X,0)) I X'="" D SETXMY D MAIL
61 Q
62MAIL ;
63 K ^TMP($J,"XQAL") S XMSUB="ALERT: "_$P(X,U,3),XMTEXT="^TMP($J,""XQAL"","
64 S ^TMP($J,"XQAL",1,0)=$P(X,U,3),^TMP($J,"XQAL",2,0)=" Forwarded by: "_$P(^VA(200,XQAUSER,0),U)_" Generated: "_$$DAT8^XQALERT($P($P(X,U,2),";",3),1) S:$G(XQACOMNT)'="" ^TMP($J,"XQAL",3,0)=XQACOMNT
65 D ^XMD
66 Q
67 ;
68PRNT ;
69 I $D(XQALST)=1,XQALST>0 S X=$O(^XTV(8992,"AXQA",XQALST,XQAUSER,0)) I X'="" S X=$G(^XTV(8992,XQAUSER,"XQA",X,0)) I X'="" D PRNT1
70 N XQAI S XQAI="" F S XQAI=$O(XQALST(XQAI)) Q:XQAI="" S X=$O(^XTV(8992,"AXQA",XQALST(XQAI),XQAUSER,0)) I X'="" S X=$G(^XTV(8992,XQAUSER,"XQA",X,0)) I X'="" D PRNT1
71 Q
72PRNT1 ;
73 U IO W @IOF
74 W !!,"ALERT: "_$P(X,U,3),!!," Forwarded by: ",$P(^VA(200,XQAUSER,0),U)," Generated on: ",$$DAT8^XQALERT($P($P(X,U,2),";",3)),!!,$G(XQACOMNT)
75 Q
76 ;
77RESETUP(XQAIDVAL,XQA,XQACOMNT) ;
78 N XQAIEN,DA,XQI,XQJ,XQK,XQX,X,X1,X3,XQARESET,XQAID,XQA1,XQADA,XQAOPT1,XQAMSG,XQACTMSG,XQADATA,XQAGUID,RETVAL,XQADA,XQADFN
79 S:'$D(XQAUSER) XQAUSER=DUZ
80 S XQARESET=1,XQALTYPE=$G(XQALTYPE,"FWD BY USER")
81 S XQAIEN=$O(^XTV(8992,"AXQA",XQAIDVAL,XQAUSER,0)) Q:XQAIEN'>0
82 S X=$G(^XTV(8992,XQAUSER,"XQA",XQAIEN,0)),X1=$G(^(1)),X3=$G(^(3))
83 Q:X=""
84 S XQAID=$P(X,U,2),XQA1=$P(XQAID,";"),XQADA=$O(^XTV(8992.1,"B",XQAID,0))
85 S XQAOPT1=$P(X,U,7,8),XQAMSG=$P(X,U,3),XQACTMSG=$P(X,U,6)
86 S XQADATA=$S(X1'="":X1,1:$P(X,U,9,100)) S:$P(X3,U)'="" XQAGUID=$P(X3,U) S:$P(X3,U,2)'="" XQADFN=$P(X3,U,2)
87 S XQX=$$NOW^XLFDT()
88 S RETVAL=$$REENT^XQALSET()
89 Q
Note: See TracBrowser for help on using the repository browser.