Changeset 623 for 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/XQALERT1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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/XQALERT1.m
r613 r623 1 XQALERT1 ;ISC-SF.SEA/JLI - ALERT HANDLER ;4/9/07 14:54 2 ;;8.0;KERNEL;**20,65,114,123,125,164,173,285,366,443**;Jul 10, 1995;Build 4 3 ;; 4 Q 5 ; 6 DOIT 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="" 10 AGAIN . 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. 29 SUBLOOP 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),XQZ4=^(4) 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 ; 41 RESTORE ; Restore a deleted message for use 42 N ALERTREF,XTVGLOB,ADUZ,X,X0,X1,X2,TIME,MESG,OPT,TAG,ROU,X4,LONG 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)),X4=$O(^(4,0)) 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),LONG=(X4>0) 49 . S X=TIME_U_XQAID_U_MESG_U_U_$S(OPT'=""!(ROU'=""):"R",LONG:"L",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 ; 54 EXIT ; 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 62 CHKSURO ; 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 ; 68 DOIT1 ; 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(XQZ4:"L",$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 ; 78 ASK0(XQI) ;Stack XQI 79 ASK ; 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 103 WAIT(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 110 WAIT2 ;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 ; 115 HELP 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 ; 130 SORT ;Sort and remove display only 131 N XQZ,XQZ1,XQZ4,XQI,XQK,XQX,XQJ 132 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)),XQZ4=$O(^(4,0)) S XQJ=$P(XQX,U,7,8) K:XQJ=U ^XTV(8992,XQAUSER,"XQA",XQI) I XQJ'=U D 133 . S XQACNT=XQACNT+1,XQJ=$S(XQAREV:999999-XQACNT,1:XQACNT),^TMP("XQ",$J,"XQA",XQJ)=XQX,^(XQJ,1)=XQI,^(2)=XQZ,^(3)=XQZ1,^(4)=XQZ4 134 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) 135 Q 136 ; 137 ASKDEL ; 138 N XQALDELE,XQX1COPY,XQAID,DA,XQAKILL,XQXOUT,XQAUSERD,XQALVALU 139 S XQALDELE=1 140 K XQX1 141 D DOIT^XQALERT1 142 K XQALDELE S XQAUSERD=1 143 I $D(XQX1),XQX1>0 D 144 . M XQX1COPY=XQX1 145 . 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) 146 . . S XQAID=$P(^TMP("XQ",$J,"XQA1",DA),U,2),XQALVALU=^(DA),XQAKILL=1 147 . . I $P(XQALVALU,U,8)=" "!$P(XQALVALU,U,10) D 148 . . . I XQAID="" K ^XTV(8992,XQAUSER,"XQA",+^TMP("XQ",$J,"XQA1",DA,1)) 149 . . . I XQAID'="" D DELETE^XQALDEL 150 . . . K ^TMP("XQ",$J,"XQA1",DA),^TMP("XQ",$J,"XQA",(999999-DA)) 151 . K XQX1 M XQX1=XQX1COPY S XQAID=0 152 . 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) 153 . . I $D(^TMP("XQ",$J,"XQA1",DA)) W:'XQAID !!,"Unable to delete alerts which require action: ",DA W:XQAID ",",DA S XQAID=1 154 . I XQAID=1 K DIR S DIR(0)="E" D ^DIR K DIR 155 K XQX1,XQAKILL 156 Q 157 ; 158 FRWRDONE ; 159 N XQX1,XQALFWDL S XQALFWDL(1)=XQAID 160 N XQAID 161 D FWDONE^XQALFWD 162 Q 1 XQALERT1 ;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 ; 6 DOIT 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="" 10 AGAIN . 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. 29 SUBLOOP 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 ; 41 RESTORE ; 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 ; 54 EXIT ; 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 62 CHKSURO ; 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 ; 68 DOIT1 ; 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 ; 78 ASK0(XQI) ;Stack XQI 79 ASK ; 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 103 WAIT(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 110 WAIT2 ;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 ; 115 HELP 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 ; 130 SORT ;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 ; 136 ASKDEL ; 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 ; 157 FRWRDONE ; 158 N XQX1,XQALFWDL S XQALFWDL(1)=XQAID 159 N XQAID 160 D FWDONE^XQALFWD 161 Q
Note:
See TracChangeset
for help on using the changeset viewer.
