source: FOIAVistA/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHT2.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1DVBHT2 ;ISC-ALBANY/PKE - HINQ alert parser ; 5/10/92 ; 2/19/03 2:49pm
2 ;;4.0;HINQ;**12,20,26,43**;03/25/92
3 ;
4 ;primary admission only
5EVENT Q:'$D(^UTILITY("DGPM",$J,1,DGPMDA)) Q:DGPMP'=""
6 S DVBDIV=0
7 I $P(^DVB(395,1,"HQ"),"^",13),$P(^DG(43,1,"GL"),"^",2) DO
8 .S DVBDIV=$S($D(^DIC(42,+$P(DGPMA,"^",6),0)):+$P(^(0),"^",11),1:0)
9 ;
10 W:'$G(DGQUIET) !,"Entering a request in the HINQ suspense file..."
11 S DVBNOWRT="" D EN^DVBHQUT
12 W:'$G(DGQUIET) "completed."
13 K DVBNOWRT,DVBDIV Q
14 ;
15 ;called from d1
16IALERT Q:$D(DVBERR) Q:$D(DVBNETER) Q:$D(DVBABREV) Q:'$D(DFN) Q:'DFN
17 Q:$P(^DVB(395.5,DFN,0),"^",6) U IO(0) W !,"Checking alert data "
18 S XQA(DUZ)="" D EN^DVBHT1 K XQA(DUZ) Q
19 ;
20 ;returns xqa(g.mailgroup or g.dvbhinq),y from hinq parameter file
21MAILGP N ENT,LKV
22 S ENT=$O(^DVB(395,0)) I ENT="" Q
23 S Y=0
24 F S Y=$O(^DVB(395,ENT,"HQMG",Y)) Q:'Y D
25 .S LKV=$P(^DVB(395,ENT,"HQMG",Y,0),"^")
26 .Q:(LKV="")
27 .Q:('$D(^XMB(3.8,LKV)))
28 .I $P(^XMB(3.8,LKV,0),"^")'="" S XQA("G."_$P(^XMB(3.8,LKV,0),"^"))=""
29 I $D(XQA)'>9 S XQA("G.DVBHINQ")="",Y=$O(^XMB(3.8,"B","DVBHINQ",0))
30 Q
31 ;returns xqa(last) or duz requester in suspense file
32REQUSR S Y=0 F S Y=$O(^DVB(395.5,DFN,1,Y)) Q:'Y I $D(^(Y,0)) DO
33 .I $G(LAST)="" S LAST=Y Q
34 .I $D(^DVB(395.5,DFN,1,LAST)),($P(^DVB(395.5,DFN,1,Y,0),"^",2)<$P(^DVB(395.5,DFN,1,LAST,0),"^",2)) Q
35 .S LAST=Y
36 I $D(LAST) S XQA(LAST)="" K LAST Q
37 S XQA(DUZ)="" Q
38 ;input y
39USR I $O(XQA(0))'?1"G.".E Q
40 Q:'Y K DVBDUZ S DVBDUZ=0
41 F S DVBDUZ=$O(^XMB(3.8,+Y,1,"B",DVBDUZ)) Q:'DVBDUZ S DVBDUZ(DVBDUZ)=""
42 Q
43 ;
44QUE ;entry to queue with taskman from prog mode
45 S ZTIO="",ZTRTN="START^DVBHT2",ZTDESC="Clear corrected HINQ alerts"
46 D ^%ZTLOAD Q
47 ;
48 ;queable
49START S DFN=0 I '$D(ZTQUEUED) W !?3,"Clearing corrected HINQ alerts",!
50 D MAILGP,USR
51 F S DFN=$O(^DVB(395.5,"AC","N",DFN)) Q:'DFN DO
52 .I '$D(^DVB(395.5,DFN,0)) Q
53 .D TEM^DVBHIQR I $D(DVBERCS) Q
54 .D ACHK^DVBHT1
55 .I '$D(DVBNOALR) Q
56 .S DVBDUZ=0 F S DVBDUZ=$O(DVBDUZ(DVBDUZ)) DO Q:'DVBDUZ ;do 1 always
57 . .S XQAID="DVB,"_DFN,XQAKILL=0
58 . .D DELETEA^XQALERT
59 . .Q
60 .I '$D(ZTQUEUED) W:$X>63 !," " W " ."
61 I '$D(ZTQUEUED),$X=1 W !?3,"No alerts cleared..."
62 D KILL^XUSCLEAN Q
Note: See TracBrowser for help on using the repository browser.