- 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 Mar 13, 2025@21:04:04 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
