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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1XQALDOIT ;ISC-SF.SEA/JLI - ALERT HANDLER ;10/25/99 09:13
2 ;;8.0;KERNEL;**1,6,65,114,128,129,207**;Jul 10, 1995
3 ;
4EN ;
5 S XQAEXIT="DOIT^XQALERT1"
6 S XQX=^TMP("XQ",$J,"XQA1",+XQX1),XQI=^(+XQX1,1),XQZ=^(2)
7EN1 ;
8 S XQADATA=$S(XQZ'="":XQZ,1:$P(XQX,U,9,99)),XQAID=$P(XQX,U,2),XQA1=$P(XQAID,";"),XQX2=+XQX1,XQX1=$P(XQX1,",",2,200) I XQX1'>0 S XQK=$O(XQX1(0)) I XQK>0 S XQX1=XQX1(XQK) K XQX1(XQK)
9 S XQAROU=""
10 S XQAKILL=1 I XQX2,$P(XQX,U,8)'="" S XQAROU=$P(XQX,U,7,8) K:XQA1="" ^XTV(8992,DUZ,"XQA",XQI)
11 I XQAID'="" D
12 . S XQXX=$O(^XTV(8992.1,"B",XQAID,0)),XQXY=0,XQADAT=$$NOW^XLFDT()
13 . I XQXX>0 S XQXY=$O(^XTV(8992.1,XQXX,20,"B",DUZ,0)) I XQXY>0,$P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)="" S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,3)=XQADAT
14 . ;I $P(XQAID,";")="NO-ID" D
15 . ;. I XQXY>0 S $P(^XTV(8992.1,XQXX,20,XQXY,0),U,4)=XQADAT,$P(^(0),U,5)=XQADAT
16 . ;. K ^XTV(8992,XQAUSER,"XQA",XQI),^XTV(8992,"AXQA",XQAID,XQAUSER,XQI),^XTV(8992,"AXQAN",$P(XQAID,";"),XQAUSER,XQI),^XTV(8992,XQAUSER,"XQA","B",$P(XQX,U),XQI),XQAID,XQAKILL
17 . K XQXX,XQXY
18 I XQAROU'="",XQAROU'="^ " S XQAROUX=XQAROU D G @XQAEXIT
19 . N XQAROUX D @XQAROU
20 . Q
21 I XQAROU'="" S XQAROUX="^ " D W !!,"Processed Alert Number ",XQX2,!?4,$P(XQX,U,3),! G @XQAEXIT
22 . I $O(^XTV(8992,DUZ,"XQA",XQI,4,0))>0 D EN^DDIOL("",$NA(^XTV(8992,DUZ,"XQA",XQI,4)))
23 . Q
24 I XQX2 S XQAROUX=$P(XQX,U,7),XQMM("J")=XQAROUX_";"_$P(^DIC(19,XQY,0),U),XQRB=0 K:XQA1="" ^XTV(8992,DUZ,"XQA",XQI)
25 K XQI,XQX,XQJ,XQK,XQXOUT,XQ1,XQII,XQA1,XQAREV,XQACNT,XQX2,%ZIS
26 ;Need to reset count in zero node
27 Q
28 ;
29ACTION(ALERTID) ;
30 N XQAUSER
31 S XQI=$O(^XTV(8992,"AXQA",ALERTID,DUZ,0))
32 Q:XQI'>0
33 S XQX=$G(^XTV(8992,DUZ,"XQA",XQI,0)) Q:XQX="" S XQAUSER=DUZ
34 S XQZ=$G(^XTV(8992,DUZ,"XQA",XQI,1))
35 I $D(XQAGETAC) Q ; just get data to return
36 S XQAEXIT="ENDACT",XQX1=XQI
37 I $P(XQX,U,8)'="" G EN1
38 D EN1
39ENDACT ;
40 I $D(XQMM("J")) S XQMM("J")=$P(XQMM("J"),";")_";",XQALEXIT=1 D D ^XQ74 K XQALEXIT,XQALMENU
41 . K XQALMENU
42 . N X S X=$P(XQMM("J"),";")
43 . I X=+X S:$P(^DIC(19,X,0),U,4)="M" XQALMENU="" Q
44 . S X=$O(^DIC(19,"B",X,0)) S:$P($G(^DIC(19,+X,0)),U,4)="M" XQALMENU=""
45 I $D(XQX1),XQX1'>0 K XQX1
46 I $D(XQAKILL) D DELETEA^XQALERT
47 K XQAKILL,XQAROU,XQAID,XQADATA
48 Q
49DOOPT(OPTION) ;
50 N XQX1,XQAKILL,XQAROU,XQADATA,XQAID,XQMM
51 S XQMM("J")=OPTION
52 D ENDACT
53 Q
54 ;
55PRINT ;
56 S XQIJ=$$NOW^XLFDT(),%ZIS="MQ" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^XQALDOIT",ZTIO=ION,ZTSAVE("XQIJ")="",ZTSAVE("^TMP(""XQ"",$J,""XQA2"",")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTIO,ZTSAVE Q
57DQ ;
58 U IO W @IOF,!!?10,"PENDING ALERTS "_$P(^VA(200,+^XTV(8992,DUZ,0),0),U)_" "_$E(XQIJ,4,5)_"/"_$E(XQIJ,6,7)_"/"_$E(XQIJ,2,3)_" "_$E($P(XQIJ,".",2)_"00",1,2)_":"_$E($P(XQIJ,".",2)_"0000",3,4),!!
59 F XQIJ=0:0 S XQIJ=$O(^TMP("XQ",$J,"XQA2",XQIJ)) Q:XQIJ'>0 W !,^(XQIJ,0)
60 D ^%ZISC K XQIJ W:'$D(ZTQUEUED) !!
61 Q
62MORP K ^TMP("XQ",$J,"XQA2") S XQIK=0 F XQIJ=0:0 S XQIJ=$O(^TMP("XQ",$J,"XQA",XQIJ)) Q:XQIJ'>0 S XQIK=XQIK+1,XQIX=^(XQIJ),^TMP("XQ",$J,"XQA2",XQIK,0)=$J(XQIK,3)_". "_$P(XQIX,U,3)
63 K XQIK,XQIX,XQIJ
64 Q
65MAIL ;
66 S XMTEXT="^TMP(""XQ"",$J,""XQA2"",",XMSUB="LIST OF PENDING ALERTS",XMY(DUZ)="",XMDUZ=.5 D ^XMD K XMTEXT,XMSUB,XMDUZ,XMY W !!,"Message will be delivered as NEW mail to YOU.",!!
67 Q
Note: See TracBrowser for help on using the repository browser.