XQALFWD ;ISC-SF.SEA/JLI - FORWARD ALERTS ;7/24/03 16:27 ;;8.0;KERNEL;**6,65,91,111,114,128,129,285**;Jul 10, 1995 Q FWRD ; ENTRY POINT FOR SELECTION FROM 'VIEW ALERTS' SCREEN ; USER NEEDS TO SELECT ALERT(S) FOR FORWARDING ; TYPE (ALERT, MAIL MESSAGE, OR PRINT) ; AND RECIPIENT(S) OR DEVICE ; AND COMMENT IF ANY TO BE DISPLAYED WITH ALERT ; W !,"Enter RETURN to continue:" R X:DTIME Q:'$T W @IOF,!,"You may now Select the alert or alerts that you want forwarded:",! N XQI,XQK,XQACNT,XQAREV,DIR S XQALFWD=1 S XQX1=-1 D DOIT^XQALERT1 K XQALFWDL S:'$D(XQX1) XQX1=-1 S:'$D(XQXOUT) XQXOUT=0 F Q:XQX1'>0 S XQALFWDL(+XQX1)=$P(^TMP("XQ",$J,"XQA1",+XQX1),U,2),XQX1=$P(XQX1,",",2,200) G:'$D(XQALFWDL) EXIT FWDONE 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 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) 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) 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" D ^DIR G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) EXIT S XQACOMNT=X K XQALFWD,DIR D FORWARD(.XQALFWDL,.XQAARR,XQATYP,XQACOMNT) EXIT S XQX1=-1 W !!,"You will now return to PROCESSING ALERTS, enter RETURN to continue:" R X:DTIME K XQALFWDL,XQAARR,XQATYP,XQACOMNT,DIRUT,XQALFWD Q ; FORWARD1(XQAID,XQARECIP,XQATYPE,XQACOMNT,XQALTYPE) ; D FORWARD(.XQAID,XQARECIP,XQATYPE,XQACOMNT) Q ; FORWARD(XQALST,XQARECIP,XQATYPE,XQACOMNT) ; Q:'$D(XQALST) Q:'$D(XQARECIP) N I,XQAVALS,XQALTYPE S XQALTYPE="FWD BY USER" S XQATYPE=$G(XQATYPE) I XQATYPE="A" D . N XQAI S XQAI="" F S XQAI=$O(XQALST(XQAI)) Q:XQAI="" D SETXQA D RESETUP(XQALST(XQAI),.XQAVALS,XQACOMNT) . I $O(XQALST(""))="",$D(XQALST)=1,XQALST'="" D SETXQA D RESETUP(XQALST,.XQAVALS,XQACOMNT) I XQATYPE="M" D . D MAIL1 I XQATYPE="P" D . S IOP=XQAARR D ^%ZIS Q:POP . D PRNT D ^%ZISC Q ; SETXQA ; I $D(XQARECIP)=1 S XQAVALS(XQARECIP)="" Q S J="" F S J=$O(XQARECIP(J)) Q:J="" S XQAVALS(XQARECIP(J))="" Q ; SETXMY ; I $D(XQARECIP)=1 S XMY(XQARECIP)="" Q S J="" F S J=$O(XQARECIP(J)) Q:J="" S XMY(XQARECIP(J))="" Q ; MAIL1 ; N I,XMY,XMSUB,XMTEXT 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 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 Q MAIL ; K ^TMP($J,"XQAL") S XMSUB="ALERT: "_$P(X,U,3),XMTEXT="^TMP($J,""XQAL""," 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 D ^XMD Q ; PRNT ; 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 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 Q PRNT1 ; U IO W @IOF 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) Q ; RESETUP(XQAIDVAL,XQA,XQACOMNT) ; N XQAIEN,DA,XQI,XQJ,XQK,XQX,X,X1,X3,XQARESET,XQAID,XQA1,XQADA,XQAOPT1,XQAMSG,XQACTMSG,XQADATA,XQAGUID,RETVAL,XQADA,XQADFN S:'$D(XQAUSER) XQAUSER=DUZ S XQARESET=1,XQALTYPE=$G(XQALTYPE,"FWD BY USER") S XQAIEN=$O(^XTV(8992,"AXQA",XQAIDVAL,XQAUSER,0)) Q:XQAIEN'>0 S X=$G(^XTV(8992,XQAUSER,"XQA",XQAIEN,0)),X1=$G(^(1)),X3=$G(^(3)) Q:X="" S XQAID=$P(X,U,2),XQA1=$P(XQAID,";"),XQADA=$O(^XTV(8992.1,"B",XQAID,0)) S XQAOPT1=$P(X,U,7,8),XQAMSG=$P(X,U,3),XQACTMSG=$P(X,U,6) 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) S XQX=$$NOW^XLFDT() S RETVAL=$$REENT^XQALSET() Q