| [613] | 1 | DVBARPUR ;557/THM-PURGE AMIE FILES ;21 JUL 89
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;NOTE: This program was designed to run on the TaskManager. There is
|
|---|
| 4 | ; no output at all. It will, however, run real-time, if desired.
|
|---|
| 5 | ;
|
|---|
| 6 | SETUP D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT ;no parameters set
|
|---|
| 7 | I '$D(DT) S X="T" D ^%DT S DT=Y
|
|---|
| 8 | ;
|
|---|
| 9 | PART1 ;for 7131 file--^DVB(396,
|
|---|
| 10 | S HIST=$S($P(^DVB(396.1,1,0),U,10)]"":$P(^(0),U,10),1:60) ;IF NOTHING SET, KEEP 60 DAYS
|
|---|
| 11 | D DATE
|
|---|
| 12 | GO S MA="" F I=0:0 S MA=$O(^DVB(396,"F",MA)) Q:MA="" S MB="" F J=0:0 S MB=$O(^DVB(396,"F",MA,MB)) Q:MB="" D KILL
|
|---|
| 13 | D PART2
|
|---|
| 14 | ;
|
|---|
| 15 | EXIT K DVBAQUIT,NODE,DIK,X,Y,MA,MB,I,J,DA,PDATE,X1,X2,HIST,%,%DT,%H,LOC
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | KILL I '$D(^DVB(396,MB,0)) K ^DVB(396,"F",MA,MB)
|
|---|
| 19 | I $D(^DVB(396,MB,0)) DO
|
|---|
| 20 | .S X1=PDATE,X2=MA D ^%DTC I X>0 S DA=MB,DIK="^DVB(396," D ^DIK K DIK,DA
|
|---|
| 21 | Q
|
|---|
| 22 | DATE S X1=DT,X2=HIST,X2=-X2 D C^%DTC S PDATE=X
|
|---|
| 23 | Q
|
|---|
| 24 | PART2 ;for NOTICE OF DISCHARGE file--^DVB(396.2
|
|---|
| 25 | S HIST=30 D DATE
|
|---|
| 26 | F LOC=0:0 S LOC=$O(^DVB(396.2,"C",LOC)) Q:LOC="" F NODE=0:0 S NODE=$O(^DVB(396.2,"C",LOC,"P",NODE)) Q:NODE="" D KILL2
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | KILL2 I '$D(^DVB(396.2,NODE)) K ^DVB(396.2,"C",LOC,"P",NODE) Q
|
|---|
| 30 | S X1=PDATE,X2=$P(^DVB(396.2,NODE,0),U,5) D ^%DTC I X>0 S DA=NODE,DIK="^DVB(396.2," D ^DIK K DIK,DA
|
|---|
| 31 | Q
|
|---|
