DVBHT2 ;ISC-ALBANY/PKE - HINQ alert parser ; 5/10/92 ; 2/19/03 2:49pm
;;4.0;HINQ;**12,20,26,43**;03/25/92
;
;primary admission only
EVENT Q:'$D(^UTILITY("DGPM",$J,1,DGPMDA)) Q:DGPMP'=""
S DVBDIV=0
I $P(^DVB(395,1,"HQ"),"^",13),$P(^DG(43,1,"GL"),"^",2) DO
.S DVBDIV=$S($D(^DIC(42,+$P(DGPMA,"^",6),0)):+$P(^(0),"^",11),1:0)
;
W:'$G(DGQUIET) !,"Entering a request in the HINQ suspense file..."
S DVBNOWRT="" D EN^DVBHQUT
W:'$G(DGQUIET) "completed."
K DVBNOWRT,DVBDIV Q
;
;called from d1
IALERT Q:$D(DVBERR) Q:$D(DVBNETER) Q:$D(DVBABREV) Q:'$D(DFN) Q:'DFN
Q:$P(^DVB(395.5,DFN,0),"^",6) U IO(0) W !,"Checking alert data "
S XQA(DUZ)="" D EN^DVBHT1 K XQA(DUZ) Q
;
;returns xqa(g.mailgroup or g.dvbhinq),y from hinq parameter file
MAILGP N ENT,LKV
S ENT=$O(^DVB(395,0)) I ENT="" Q
S Y=0
F S Y=$O(^DVB(395,ENT,"HQMG",Y)) Q:'Y D
.S LKV=$P(^DVB(395,ENT,"HQMG",Y,0),"^")
.Q:(LKV="")
.Q:('$D(^XMB(3.8,LKV)))
.I $P(^XMB(3.8,LKV,0),"^")'="" S XQA("G."_$P(^XMB(3.8,LKV,0),"^"))=""
I $D(XQA)'>9 S XQA("G.DVBHINQ")="",Y=$O(^XMB(3.8,"B","DVBHINQ",0))
Q
;returns xqa(last) or duz requester in suspense file
REQUSR S Y=0 F S Y=$O(^DVB(395.5,DFN,1,Y)) Q:'Y I $D(^(Y,0)) DO
.I $G(LAST)="" S LAST=Y Q
.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
.S LAST=Y
I $D(LAST) S XQA(LAST)="" K LAST Q
S XQA(DUZ)="" Q
;input y
USR I $O(XQA(0))'?1"G.".E Q
Q:'Y K DVBDUZ S DVBDUZ=0
F S DVBDUZ=$O(^XMB(3.8,+Y,1,"B",DVBDUZ)) Q:'DVBDUZ S DVBDUZ(DVBDUZ)=""
Q
;
QUE ;entry to queue with taskman from prog mode
S ZTIO="",ZTRTN="START^DVBHT2",ZTDESC="Clear corrected HINQ alerts"
D ^%ZTLOAD Q
;
;queable
START S DFN=0 I '$D(ZTQUEUED) W !?3,"Clearing corrected HINQ alerts",!
D MAILGP,USR
F S DFN=$O(^DVB(395.5,"AC","N",DFN)) Q:'DFN DO
.I '$D(^DVB(395.5,DFN,0)) Q
.D TEM^DVBHIQR I $D(DVBERCS) Q
.D ACHK^DVBHT1
.I '$D(DVBNOALR) Q
.S DVBDUZ=0 F S DVBDUZ=$O(DVBDUZ(DVBDUZ)) DO Q:'DVBDUZ ;do 1 always
. .S XQAID="DVB,"_DFN,XQAKILL=0
. .D DELETEA^XQALERT
. .Q
.I '$D(ZTQUEUED) W:$X>63 !," " W " ."
I '$D(ZTQUEUED),$X=1 W !?3,"No alerts cleared..."
D KILL^XUSCLEAN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHT2 2207 printed Oct 16, 2024@18:00:02 Page 2
DVBHT2 ;ISC-ALBANY/PKE - HINQ alert parser ; 5/10/92 ; 2/19/03 2:49pm
+1 ;;4.0;HINQ;**12,20,26,43**;03/25/92
+2 ;
+3 ;primary admission only
EVENT if '$DATA(^UTILITY("DGPM",$JOB,1,DGPMDA))
QUIT
if DGPMP'=""
QUIT
+1 SET DVBDIV=0
+2 IF $PIECE(^DVB(395,1,"HQ"),"^",13)
IF $PIECE(^DG(43,1,"GL"),"^",2)
Begin DoDot:1
+3 SET DVBDIV=$SELECT($DATA(^DIC(42,+$PIECE(DGPMA,"^",6),0)):+$PIECE(^(0),"^",11),1:0)
End DoDot:1
+4 ;
+5 if '$GET(DGQUIET)
WRITE !,"Entering a request in the HINQ suspense file..."
+6 SET DVBNOWRT=""
DO EN^DVBHQUT
+7 if '$GET(DGQUIET)
WRITE "completed."
+8 KILL DVBNOWRT,DVBDIV
QUIT
+9 ;
+10 ;called from d1
IALERT if $DATA(DVBERR)
QUIT
if $DATA(DVBNETER)
QUIT
if $DATA(DVBABREV)
QUIT
if '$DATA(DFN)
QUIT
if 'DFN
QUIT
+1 if $PIECE(^DVB(395.5,DFN,0),"^",6)
QUIT
USE IO(0)
WRITE !,"Checking alert data "
+2 SET XQA(DUZ)=""
DO EN^DVBHT1
KILL XQA(DUZ)
QUIT
+3 ;
+4 ;returns xqa(g.mailgroup or g.dvbhinq),y from hinq parameter file
MAILGP NEW ENT,LKV
+1 SET ENT=$ORDER(^DVB(395,0))
IF ENT=""
QUIT
+2 SET Y=0
+3 FOR
SET Y=$ORDER(^DVB(395,ENT,"HQMG",Y))
if 'Y
QUIT
Begin DoDot:1
+4 SET LKV=$PIECE(^DVB(395,ENT,"HQMG",Y,0),"^")
+5 if (LKV="")
QUIT
+6 if ('$DATA(^XMB(3.8,LKV)))
QUIT
+7 IF $PIECE(^XMB(3.8,LKV,0),"^")'=""
SET XQA("G."_$PIECE(^XMB(3.8,LKV,0),"^"))=""
End DoDot:1
+8 IF $DATA(XQA)'>9
SET XQA("G.DVBHINQ")=""
SET Y=$ORDER(^XMB(3.8,"B","DVBHINQ",0))
+9 QUIT
+10 ;returns xqa(last) or duz requester in suspense file
REQUSR SET Y=0
FOR
SET Y=$ORDER(^DVB(395.5,DFN,1,Y))
if 'Y
QUIT
IF $DATA(^(Y,0))
Begin DoDot:1
+1 IF $GET(LAST)=""
SET LAST=Y
QUIT
+2 IF $DATA(^DVB(395.5,DFN,1,LAST))
IF ($PIECE(^DVB(395.5,DFN,1,Y,0),"^",2)<$PIECE(^DVB(395.5,DFN,1,LAST,0),"^",2))
QUIT
+3 SET LAST=Y
End DoDot:1
+4 IF $DATA(LAST)
SET XQA(LAST)=""
KILL LAST
QUIT
+5 SET XQA(DUZ)=""
QUIT
+6 ;input y
USR IF $ORDER(XQA(0))'?1"G.".E
QUIT
+1 if 'Y
QUIT
KILL DVBDUZ
SET DVBDUZ=0
+2 FOR
SET DVBDUZ=$ORDER(^XMB(3.8,+Y,1,"B",DVBDUZ))
if 'DVBDUZ
QUIT
SET DVBDUZ(DVBDUZ)=""
+3 QUIT
+4 ;
QUE ;entry to queue with taskman from prog mode
+1 SET ZTIO=""
SET ZTRTN="START^DVBHT2"
SET ZTDESC="Clear corrected HINQ alerts"
+2 DO ^%ZTLOAD
QUIT
+3 ;
+4 ;queable
START SET DFN=0
IF '$DATA(ZTQUEUED)
WRITE !?3,"Clearing corrected HINQ alerts",!
+1 DO MAILGP
DO USR
+2 FOR
SET DFN=$ORDER(^DVB(395.5,"AC","N",DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 IF '$DATA(^DVB(395.5,DFN,0))
QUIT
+4 DO TEM^DVBHIQR
IF $DATA(DVBERCS)
QUIT
+5 DO ACHK^DVBHT1
+6 IF '$DATA(DVBNOALR)
QUIT
+7 ;do 1 always
SET DVBDUZ=0
FOR
SET DVBDUZ=$ORDER(DVBDUZ(DVBDUZ))
Begin DoDot:2
+8 SET XQAID="DVB,"_DFN
SET XQAKILL=0
+9 DO DELETEA^XQALERT
+10 QUIT
End DoDot:2
if 'DVBDUZ
QUIT
+11 IF '$DATA(ZTQUEUED)
if $X>63
WRITE !," "
WRITE " ."
End DoDot:1
+12 IF '$DATA(ZTQUEUED)
IF $X=1
WRITE !?3,"No alerts cleared..."
+13 DO KILL^XUSCLEAN
QUIT
