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/XQALERT1.m@ 996

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

WorldVistAEHR overlayed on FOIAVistA
File size: 9.3 KB
Line 
1XQALERT1 ;ISC-SF.SEA/JLI - ALERT HANDLER ;9/6/05 15:13
2 ;;8.0;KERNEL;**20,65,114,123,125,164,173,285,366**;Jul 10, 1995
3 ;;
4 Q
5 ;
6DOIT I $D(XQX1),XQX1'>0 K XQX1
7 I $D(XQAID) D I '$D(XQAID) G EXIT
8 . N XQACHOIC,REASK S REASK=0
9 . I '$D(XQX1),$O(^XTV(8992,XQAUSER,"XQA",+$O(^XTV(8992,XQAUSER,"XQA",0))))'>0,$G(XQAROUX)="^ " S XQAROU=""
10AGAIN . S XQACHOIC="Y:YES;N:NO;C:CONTINUE;",XQAQ("?")="Enter Y (or C) to continue, N to exit alert processing"
11 . S XQACHOIC=$G(XQACHOIC)_"F:FORWARD ALERT;R:RENEW(MAKE NEW AGAIN);" S XQAQ("?",1)="Enter F to forward this alert to someone else",XQAQ("?",2)="Enter R to Renew (Make New) this alert"
12 . D I REASK=1 G AGAIN
13 . . S REASK=0 W !! K DIR S DIR(0)="SA^"_XQACHOIC,DIR("A")=$S(XQACHOIC["F:":"Continue (Y/N) or F(orward) or R(enew) ",1:"Continue Processing (Y/N) "),DIR("B")="YES" M DIR("?")=XQAQ("?") D ^DIR K DIR
14 . . I $D(DUOUT)!$D(DIRUT) S Y="N" K DUOUT,DIRUT
15 . . I Y="N" D:$D(XQAKILL) DELETEA^XQALERT K XQAID
16 . . I Y="R" S REASK=REASK+1 K XQAKILL I '$D(^XTV(8992,"AXQA",XQAID,DUZ)) D RESTORE
17 . . I Y="F" D:'$D(^XTV(8992,"AXQA",XQAID,DUZ)) RESTORE D FRWRDONE S REASK=REASK+1
18 . . Q
19 . Q
20 I $D(XQAKILL) D DELETEA^XQALERT
21 S XQAREV=1,XQXOUT=0,XQK=0,XQACNT=0 K XQADATA,XQAID,XQAROU,XQAKILL,XQAROUX
22 I '$D(XQX1) S XQX1=0 K ^TMP("XQ",$J,"XQA"),^("XQA1"),^("XQA2") I $O(^XTV(8992,XQAUSER,"XQA",0))'>0 K XQX1 D:'$G(^TMP("XQALERT1",$J,"NOTFIRST")) CHKSURO G:$O(^XTV(8992,XQAUSER,"XQA",0))'>0 EXIT S XQX1=0 ; P366
23 I $$ACTVSURO^XQALSURO(XQAUSER)'>0 D RETURN^XQALSUR1(XQAUSER) ; P366
24 S ^TMP("XQALERT1",$J,"NOTFIRST")=1 ; Added 2/2/99 jli to clear flag for initial entry
25 ;Sort and remove display only
26 I 'XQX1 W !!! D
27 . D SORT
28 ; Now display them.
29SUBLOOP W @IOF
30 N XQZ1,XQZ
31 S XQK=0 F XQI=0:0 Q:XQX1!XQXOUT S XQI=$O(^TMP("XQ",$J,"XQA",XQI)) Q:XQI'>0 S XQX=^(XQI),XQII=^(XQI,1),XQZ=^(2),XQZ1=^(3) D I XQX'="" D DOIT1
32 . I '$D(^XTV(8992,XQAUSER,"XQA",XQII)) S XQX="" K ^TMP("XQ",$J,"XQA",XQI),^TMP("XQ",$J,"XQA1",(999999-XQI))
33 . Q
34 S:'$D(XQXOUT) XQXOUT=0 G:XQXOUT EXIT G:XQK'>0&'XQX1 EXIT I 'XQX1 D ASK G:XQXOUT EXIT
35 G:+XQX1=0 EXIT I XQX1<0 S XQX1=0 G DOIT
36 I $D(XQALDELE)!$D(XQALFWD) Q
37 ;D WAIT(+XQX1) G:XQXOUT EXIT
38 G:XQXOUT EXIT
39 G EN^XQALDOIT
40 ;
41RESTORE ; Restore a deleted message for use
42 N ALERTREF,XTVGLOB,ADUZ,X,X0,X1,X2,TIME,MESG,OPT,TAG,ROU
43 S XTVGLOB=$NA(^XTV(8992,DUZ,"XQA"))
44 S ADUZ=$O(^XTV(8992,"AXQA",XQAID,0)) I ADUZ>0 S TIME=$O(^(ADUZ,0)) D I 1
45 . M @XTVGLOB@(TIME)=^XTV(8992,ADUZ,"XQA",TIME) K @XTVGLOB@(TIME,2) ; copy alert, kill comment if any
46 E S ALERTREF=$O(^XTV(8992.1,"B",XQAID,0)) Q:ALERTREF'>0 D ; otherwise rebuild from alert tracking file if possible
47 . S X0=^XTV(8992.1,ALERTREF,0),X1=$G(^(1)),X2=$G(^(2))
48 . S TIME=$P($P(X0,U),";",3),MESG=$P(X1,U),OPT=$P(X1,U,2),TAG=$P(X1,U,3),ROU=$P(X1,U,4)
49 . S X=TIME_U_XQAID_U_MESG_U_U_$S(OPT'=""!(ROU'=""):"R",1:"I")_U_U_$S(OPT'="":OPT,TAG'="":TAG,1:"")_U_$S(OPT'="":"",ROU'="":ROU,1:" ")
50 . S @XTVGLOB@(TIME,0)=X I $G(X2)'="" S ^(1)=X2
51 S ^XTV(8992,"AXQA",XQAID,DUZ,TIME)="",^XTV(8992,"AXQAN",$E($P(XQAID,";"),1,30),DUZ,TIME)=""
52 Q
53 ;
54EXIT ;
55 I $G(XQALAST)="I",$G(DUZ("AUTO")) D WAIT2
56 I $D(XQALDELE)!$D(XQALFWD) Q
57 K ^TMP("XQ",$J,"XQA"),^("XQA1"),^("XQA2"),XQI,XQX,XQJ,XQK,XQX1,XQX2,XQXOUT,XQ1,XQII,XQACNT,XQA1,XQAREV,%ZIS,XQAROU,XQALAST,XQAROUX,XQON,XQOFF,XQ1ON,XQ1OFF,XQOUT,XQAQ
58 K ^TMP("XQALERT1",$J)
59 Q
60 ;
61 ; CHKSURO added 2/2/99 to give user opportunity to add/remove surrogate if no alerts present
62CHKSURO ; If user selects process alerts with no alerts present, give him/her the opportunity to add or delete a surrogate
63 ; P366 - list currently established surrogates if any
64 I '$G(^TMP("XQALERT1",$J,"NOTFIRST")) W !!,"You have no alerts for processing.",!
65 D SURROGAT^XQALSURO ; XU*8*17
66 Q
67 ;
68DOIT1 ;
69 I XQK=0 S XQALINFO=0 I '$D(XQALFWD) W @IOF
70 S XQON="$C(0)",XQOFF="$C(0)" S XQOUT=$P(XQX,U,3) I ($$UP^XLFSTR(XQOUT)["CRITICAL")!($$UP^XLFSTR(XQOUT)["ABNORMAL IMA") D:'$D(XQ1ON) SETREV^XQALERT S XQON=XQ1ON,XQOFF=XQ1OFF ; P285
71 S XQK=XQK+1 W !,$J(XQK,2),".",$S($P(XQX,U,8)=" ":"I",1:" ")," ",@XQON,$E($P(XQX,U,3),1,70),@XQOFF S:$P(XQX,U,8)=" " XQALINFO=XQALINFO+1 D:XQZ1'="" ; P285
72 . W !?8,"Forwarded by: ",$P(^VA(200,+XQZ1,0),U)," Generated: ",$$DAT8^XQALERT(+$P($P(XQX,U,2),";",3),1)
73 . I $P(XQZ1,U,3)'="" W !?8,$P(XQZ1,U,3)
74 S ^TMP("XQ",$J,"XQA1",XQK)=XQX,^(XQK,1)=XQII,^(2)=XQZ,^(3)=XQZ1
75 I ($Y+6)>IOSL N XQKVALUE S XQKVALUE=XQK D ASK0(XQI) S:'$D(XQK) XQK=XQKVALUE Q:XQX1!(XQXOUT) W @IOF
76 Q
77 ;
78ASK0(XQI) ;Stack XQI
79ASK ;
80 N XQALNEWF K XQALAST
81 ;I '$D(XQALDELE)&'$D(XQALFWD) S XQALNEWF=$P(^XTV(8992,XQAUSER,0),U,5) I XQALNEWF<20 D
82 ;. N XQALFDA
83 ;. S XQALNEWF=XQALNEWF+1,XQALFDA=(8992,(XQAUSER_","),.05)=XQALNEWF D FILE^DIE("","XQALFDA")
84 ;. W !,"NEW OPTIONS: S-to add/remove SURROGATE and D-to selectively Delete SOME alerts"
85 S XQ1=0,XQXOUT=0 W !?10,"Select from 1 to ",XQK W:$D(XQALDELE) " to DELETE" W:$D(XQALFWD) " to FORWARD"
86 W !?10,"or enter ?, A, " W:'$D(XQALDELE)&'$D(XQALFWD)&(XQALINFO>0) "I, D, " W:'$D(XQALDELE)&'$D(XQALFWD) "F, S, P, M, R, " W "or ^ to exit" I XQI>0,$O(^XTV(8992,XQAUSER,"XQA",XQI))>0 W !?10,"or RETURN to continue" S XQ1=1
87 R ": ",XQII:DTIME S:'$T!(XQII[U)!(XQII=""&'XQ1) XQXOUT=1 Q:XQXOUT
88 I '$D(XQALDELE)&'$D(XQALFWD),"PpMm"[$E(XQII_".") D MORP^XQALDOIT D:"Pp"[$E(XQII_".") PRINT^XQALDOIT D:"Mm"[$E(XQII_".") MAIL^XQALDOIT K ^TMP("XQ",$J,"XQA2") G ASK
89 I XQII'="",XQII["?" D HELP G ASK
90 I XQII=""&XQ1 Q
91 I "IiAaFfRrSsDd"'[$E(XQII_"."),$L(XQII)>31,$E(XQII,1,32)?1N.N W !,$C(7)," ?? Invalid number entered",! G ASK
92 I "IiAaFfRrSsDd"'[$E(XQII_"."),(XQII<1)!(XQII>XQK) W $C(7)," ??",! G ASK
93 I '$D(XQALDELE)&'$D(XQALFWD),"Ff"[$E(XQII) D FWRD^XQALFWD S XQX1=-2 Q ; MODIFIED 7-6
94 I '$D(XQALDELE)&'$D(XQALFWD),"Ss"[$E(XQII) D CHKSURO S XQX1=-1 Q
95 I '$D(XQALDELE)&'$D(XQALFWD),"Dd"[$E(XQII) D ASKDEL S XQX1=-2 Q ; MODIFIED 7-6
96 I '$D(XQALDELE),"Rr"[$E(XQII) S XQX1=-2 Q
97 I "Aa"[$E(XQII) S X="1-"_XQACNT,DIR(0)="LV^1:"_XQACNT D ^DIR K DIR,XQX1 M XQX1=Y S XQII="" K Y ;Merge list from Y
98 I XQII'="","Ii"[$E(XQII) S XQX1(0)="",XQX2=0,XQII="" F XQK=0:0 S XQK=$O(^TMP("XQ",$J,"XQA1",XQK)) S:XQK'>0 XQX1=XQX1(0) Q:XQK'>0 I $P(^(XQK),U,7,8)="^ " S XQX1(XQX2)=XQX1(XQX2)_XQK_"," S:$L(XQX1(XQX2))>240 XQX2=XQX2+1,XQX1(XQX2)=""
99 I XQII="" Q
100 S X=XQII,DIR(0)="LV^1:"_XQK D ^DIR I '$D(Y) W $C(7)," ??" D HELP G ASK ;Use of 'LV' is special
101 K XQX1 M XQX1=Y K Y S Y=XQX1 ;Merge list from Y
102 Q
103WAIT(IFN) ;Wait for user input if last alert is INFO and next isn't.
104 N X,YY Q:$G(XQXOUT)
105 S X=$G(^TMP("XQ",$J,"XQA1",IFN)),YY=$P(X,U,7,8),YY=$S(YY="^ ":"I",YY="^":"O",1:"R")
106 I $G(XQALAST)="I","OR"[YY D WAIT2
107 I YY="I",$Y+4>IOSL D WAIT2 W @IOF
108 S XQALAST=YY
109 Q
110WAIT2 ;Wait for user input before continuing
111 N DIR,Y,DIROUT,DIRUT S DIR(0)="E",DIR("?")="The next ALERT may cause the loss of info on the screen."
112 D ^DIR S:$D(DIRUT) XQXOUT=1
113 Q
114 ;
115HELP W !!,"YOU MAY ENTER:",!?3,$S(XQK>1:"One or more numbers",1:"A number")," in the range 1 to ",XQK," to select specific alert(s)"
116 W !?6,"for "_$S($D(XQALDELE):"DELETION.",$D(XQALFWD):"FORWARDING",1:"processing.") W:XQK>1 " This may be a series of numbers, e.g., 2,3,6-9"
117 W !?3,"A to "_$S($D(XQALDELE):"DELETE",$D(XQALFWD):"FORWARD",1:"process")," all of the pending alerts in the order shown."
118 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"I to process all of the INFORMATION ONLY alerts, if any, without further ado."
119 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"S to add or remove a surrogate to receive alerts for you"
120 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"F to forward one or more specific alerts. Forwarding may be as an ALERT",!,"to specific user(s) and/or mail group(s), or as a MAIL MESSAGE, or to a",!,"specific PRINTER."
121 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"D to delete specific alerts (some alerts may not be deleted)"
122 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"P to print a copy of the pending alerts on a printer"
123 W:'$D(XQALDELE)&'$D(XQALFWD) !?3,"M to receive a MailMan message containing a copy of these pending alerts"
124 W:'$D(XQALDELE) !?3,"R to Redisplay the available alerts"
125 W !?3,"^ to exit"
126 I XQI W !?5,"or RETURN to see additional pending ALERTS"
127 W !!
128 Q
129 ;
130SORT ;Sort and remove display only
131 F XQI=0:0 S XQI=$O(^XTV(8992,XQAUSER,"XQA",XQI)) Q:XQI'>0 S XQX=^(XQI,0),XQZ=$G(^(1)),XQZ1=$G(^(2)) S XQJ=$P(XQX,U,7,8) K:XQJ=U ^XTV(8992,XQAUSER,"XQA",XQI) I XQJ'=U D
132 . S XQACNT=XQACNT+1,XQJ=$S(XQAREV:999999-XQACNT,1:XQACNT),^TMP("XQ",$J,"XQA",XQJ)=XQX,^(XQJ,1)=XQI,^(2)=XQZ,^(3)=XQZ1
133 S XQK=0 F XQI=0:0 S XQI=$O(^TMP("XQ",$J,"XQA",XQI)) Q:XQI'>0 S XQK=XQK+1 M ^TMP("XQ",$J,"XQA1",XQK)=^TMP("XQ",$J,"XQA",XQI)
134 Q
135 ;
136ASKDEL ;
137 N XQALDELE,XQX1COPY,XQAID,DA,XQAKILL,XQXOUT,XQAUSERD,XQALVALU
138 S XQALDELE=1
139 K XQX1
140 D DOIT^XQALERT1
141 K XQALDELE S XQAUSERD=1
142 I $D(XQX1),XQX1>0 D
143 . M XQX1COPY=XQX1
144 . F Q:XQX1="" S DA=+XQX1,XQX1=$P(XQX1,",",2,99) D I XQX1="" S Y=$O(XQX1(0)) I Y>0 S XQX1=XQX1(Y) K XQX1(Y)
145 . . S XQAID=$P(^TMP("XQ",$J,"XQA1",DA),U,2),XQALVALU=^(DA),XQAKILL=1
146 . . I $P(XQALVALU,U,8)=" "!$P(XQALVALU,U,10) D
147 . . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1))
148 . . . I XQAID'="" D DELETE^XQALDEL
149 . . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA))
150 . K XQX1 M XQX1=XQX1COPY S XQAID=0
151 . F Q:XQX1="" S DA=+XQX1,XQX1=$P(XQX1,",",2,99) D I XQX1="" S Y=$O(XQX1(0)) I Y>0 S XQX1=XQX1(Y) K XQX1(Y)
152 . . I $D(^TMP("XQ",$J,"XQA1",DA)) W:'XQAID !!,"Unable to delete alerts which require action: ",DA W:XQAID ",",DA S XQAID=1
153 . I XQAID=1 K DIR S DIR(0)="E" D ^DIR K DIR
154 K XQX1,XQAKILL
155 Q
156 ;
157FRWRDONE ;
158 N XQX1,XQALFWDL S XQALFWDL(1)=XQAID
159 N XQAID
160 D FWDONE^XQALFWD
161 Q
Note: See TracBrowser for help on using the repository browser.