source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBARPUR.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.2 KB
Line 
1DVBARPUR ;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 ;
6SETUP D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT ;no parameters set
7 I '$D(DT) S X="T" D ^%DT S DT=Y
8 ;
9PART1 ;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
12GO 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 ;
15EXIT K DVBAQUIT,NODE,DIK,X,Y,MA,MB,I,J,DA,PDATE,X1,X2,HIST,%,%DT,%H,LOC
16 Q
17 ;
18KILL 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
22DATE S X1=DT,X2=HIST,X2=-X2 D C^%DTC S PDATE=X
23 Q
24PART2 ;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 ;
29KILL2 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
Note: See TracBrowser for help on using the repository browser.