source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQPU.m@ 789

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1DVBHQPU ;ISC-ALBANY/PKE-Purge Hinq suspense file ; 04 OCT 85 12:46 pm
2 ;;V4.0;HINQ;**18**;03/25/92
3ASK ;
4 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
5 S DVBSTOP="" Q
6EN 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
7 ;
8 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
9 Q
107 S X="T-7",%DT="" W:'$D(ZTSK) # D DAT,QUE Q
1130 S X="T-30",%DT="" W:'$D(ZTSK) # S DVBALERT=1 D DAT,QUE Q
12DAT S U="^" D ^%DT S DVBDAY=9999999-Y,DIK="^DVB(395.5,"
13 Q
14LAST S DIK="^DVB(395.5,"
15 I $D(^DVB(395,1,"HQ")),+$P(^("HQ"),U,2) S DVBDAY=9999999-$P(^("HQ"),U,2)
16 E S X="T-2",%DT="" D ^%DT Q:Y<0 S DVBDAY=9999999-Y
17 ;
18QUE 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) "."
19 W:'$D(ZTSK) !!,?9,CT," Entries deleted from suspense file",$C(7)
20EX K DFN,DA,DIE,DIC,DIK,ZTSK,%,%Y,DVBSTOP,DVBDAY,%DT,%DT(0),%DT("A"),X,Y,DIC(0),CT,DR,DVBALERT QUIT
21 ;
221 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
23 Q
24 ;
25KALERT ;kills off any alerts associated with this HINQ. This is only intended
26 ;to be used with the 30 day purging date. This should not be changed
27 ;by the sites.
28 D MAILGP^DVBHT2,REQUSR^DVBHT2
29 S XQAID="DVB,"_DFN,XQAKILL=0
30 D DELETEA^XQALERT
31 K XQAID,XQAKILL
32 Q
Note: See TracBrowser for help on using the repository browser.