DVBHQPU ;ISC-ALBANY/PKE-Purge Hinq suspense file ; 04 OCT 85 12:46 pm
;;V4.0;HINQ;**18**;03/25/92
ASK ;
W !!,"Entries in the HINQ Suspense file before the last 30 days",!,"will be deleted ",!!,"Do You wish to continue "_$C(7) S %=2 D YN^DICN G EX:%'=1
S DVBSTOP="" Q
EN W !!,"When you enter a date all entries in the HINQ Suspense",!,"file before that date will be deleted",!!,"DO you wish to continue "_$C(7) S %=2 D YN^DICN G EX:%'=1
;
W ! S X="T-1",%DT="" D DAT S %DT("A")="Enter the oldest date to retain in the HINQ Suspense file ? ",%DT(0)=-DVBSTOP,%DT="AEPX" D ^%DT K %DT(0) G EX:Y<0 S DVBSTOP=Y D QUE G EX
Q
7 S X="T-7",%DT="" W:'$D(ZTSK) # D DAT,QUE Q
30 S X="T-30",%DT="" W:'$D(ZTSK) # S DVBALERT=1 D DAT,QUE Q
DAT S U="^" D ^%DT S DVBDAY=9999999-Y,DIK="^DVB(395.5,"
Q
LAST S DIK="^DVB(395.5,"
I $D(^DVB(395,1,"HQ")),+$P(^("HQ"),U,2) S DVBDAY=9999999-$P(^("HQ"),U,2)
E S X="T-2",%DT="" D ^%DT Q:Y<0 S DVBDAY=9999999-Y
;
QUE F CT=0:0 S DVBDAY=$O(^DVB(395.5,"C",DVBDAY)) Q:'DVBDAY F DFN=0:0 S DFN=$O(^DVB(395.5,"C",DVBDAY,DFN)) Q:'DFN Q:'$D(^DVB(395.5,DFN,0)) S DA=DFN D 1,^DIK,KALERT:$D(DVBALERT) S CT=CT+1 W:'$D(ZTSK) "."
W:'$D(ZTSK) !!,?9,CT," Entries deleted from suspense file",$C(7)
EX K DFN,DA,DIE,DIC,DIK,ZTSK,%,%Y,DVBSTOP,DVBDAY,%DT,%DT(0),%DT("A"),X,Y,DIC(0),CT,DR,DVBALERT QUIT
;
1 S Y=$P(^DVB(395.5,DFN,0),U,3) D DD^%DT W:'$D(ZTSK) !,$S($D(^DPT(DFN,0)):$P(^(0),U),1:DFN),?30,Y
Q
;
KALERT ;kills off any alerts associated with this HINQ. This is only intended
;to be used with the 30 day purging date. This should not be changed
;by the sites.
D MAILGP^DVBHT2,REQUSR^DVBHT2
S XQAID="DVB,"_DFN,XQAKILL=0
D DELETEA^XQALERT
K XQAID,XQAKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQPU 1724 printed Dec 13, 2024@01:58:48 Page 2
DVBHQPU ;ISC-ALBANY/PKE-Purge Hinq suspense file ; 04 OCT 85 12:46 pm
+1 ;;V4.0;HINQ;**18**;03/25/92
ASK ;
+1 WRITE !!,"Entries in the HINQ Suspense file before the last 30 days",!,"will be deleted ",!!,"Do You wish to continue "_$CHAR(7)
SET %=2
DO YN^DICN
if %'=1
GOTO EX
+2 SET DVBSTOP=""
QUIT
EN WRITE !!,"When you enter a date all entries in the HINQ Suspense",!,"file before that date will be deleted",!!,"DO you wish to continue "_$CHAR(7)
SET %=2
DO YN^DICN
if %'=1
GOTO EX
+1 ;
+2 WRITE !
SET X="T-1"
SET %DT=""
DO DAT
SET %DT("A")="Enter the oldest date to retain in the HINQ Suspense file ? "
SET %DT(0)=-DVBSTOP
SET %DT="AEPX"
DO ^%DT
KILL %DT(0)
if Y<0
GOTO EX
SET DVBSTOP=Y
DO QUE
GOTO EX
+3 QUIT
7 SET X="T-7"
SET %DT=""
if '$DATA(ZTSK)
WRITE #
DO DAT
DO QUE
QUIT
30 SET X="T-30"
SET %DT=""
if '$DATA(ZTSK)
WRITE #
SET DVBALERT=1
DO DAT
DO QUE
QUIT
DAT SET U="^"
DO ^%DT
SET DVBDAY=9999999-Y
SET DIK="^DVB(395.5,"
+1 QUIT
LAST SET DIK="^DVB(395.5,"
+1 IF $DATA(^DVB(395,1,"HQ"))
IF +$PIECE(^("HQ"),U,2)
SET DVBDAY=9999999-$PIECE(^("HQ"),U,2)
+2 IF '$TEST
SET X="T-2"
SET %DT=""
DO ^%DT
if Y<0
QUIT
SET DVBDAY=9999999-Y
+3 ;
QUE FOR CT=0:0
SET DVBDAY=$ORDER(^DVB(395.5,"C",DVBDAY))
if 'DVBDAY
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^DVB(395.5,"C",DVBDAY,DFN))
if 'DFN
QUIT
if '$DATA(^DVB(395.5,DFN,0))
QUIT
SET DA=DFN
DO 1
DO ^DIK
if $DATA(DVBALERT)
DO KALERT
SET CT=CT+1
if '$DATA(ZTSK)
WRITE "."
+1 if '$DATA(ZTSK)
WRITE !!,?9,CT," Entries deleted from suspense file",$CHAR(7)
EX KILL DFN,DA,DIE,DIC,DIK,ZTSK,%,%Y,DVBSTOP,DVBDAY,%DT,%DT(0),%DT("A"),X,Y,DIC(0),CT,DR,DVBALERT
QUIT
+1 ;
1 SET Y=$PIECE(^DVB(395.5,DFN,0),U,3)
DO DD^%DT
if '$DATA(ZTSK)
WRITE !,$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U),1:DFN),?30,Y
+1 QUIT
+2 ;
KALERT ;kills off any alerts associated with this HINQ. This is only intended
+1 ;to be used with the 30 day purging date. This should not be changed
+2 ;by the sites.
+3 DO MAILGP^DVBHT2
DO REQUSR^DVBHT2
+4 SET XQAID="DVB,"_DFN
SET XQAKILL=0
+5 DO DELETEA^XQALERT
+6 KILL XQAID,XQAKILL
+7 QUIT
