Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBARPUR

DVBARPUR.m

Go to the documentation of this file.
  1. DVBARPUR ;557/THM-PURGE AMIE FILES ;21 JUL 89
  1. ;;2.7;AMIE;;Apr 10, 1995
  1. ;NOTE: This program was designed to run on the TaskManager. There is
  1. ; no output at all. It will, however, run real-time, if desired.
  1. ;
  1. SETUP D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT ;no parameters set
  1. I '$D(DT) S X="T" D ^%DT S DT=Y
  1. ;
  1. PART1 ;for 7131 file--^DVB(396,
  1. S HIST=$S($P(^DVB(396.1,1,0),U,10)]"":$P(^(0),U,10),1:60) ;IF NOTHING SET, KEEP 60 DAYS
  1. D DATE
  1. 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
  1. D PART2
  1. ;
  1. EXIT K DVBAQUIT,NODE,DIK,X,Y,MA,MB,I,J,DA,PDATE,X1,X2,HIST,%,%DT,%H,LOC
  1. Q
  1. ;
  1. KILL I '$D(^DVB(396,MB,0)) K ^DVB(396,"F",MA,MB)
  1. I $D(^DVB(396,MB,0)) DO
  1. .S X1=PDATE,X2=MA D ^%DTC I X>0 S DA=MB,DIK="^DVB(396," D ^DIK K DIK,DA
  1. Q
  1. DATE S X1=DT,X2=HIST,X2=-X2 D C^%DTC S PDATE=X
  1. Q
  1. PART2 ;for NOTICE OF DISCHARGE file--^DVB(396.2
  1. S HIST=30 D DATE
  1. 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
  1. Q
  1. ;
  1. KILL2 I '$D(^DVB(396.2,NODE)) K ^DVB(396.2,"C",LOC,"P",NODE) Q
  1. 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
  1. Q