DVBARPUR ;557/THM-PURGE AMIE FILES ;21 JUL 89
;;2.7;AMIE;;Apr 10, 1995
;NOTE: This program was designed to run on the TaskManager. There is
; no output at all. It will, however, run real-time, if desired.
;
SETUP D NOPARM^DVBAUTL2 G:$D(DVBAQUIT) EXIT ;no parameters set
I '$D(DT) S X="T" D ^%DT S DT=Y
;
PART1 ;for 7131 file--^DVB(396,
S HIST=$S($P(^DVB(396.1,1,0),U,10)]"":$P(^(0),U,10),1:60) ;IF NOTHING SET, KEEP 60 DAYS
D DATE
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
D PART2
;
EXIT K DVBAQUIT,NODE,DIK,X,Y,MA,MB,I,J,DA,PDATE,X1,X2,HIST,%,%DT,%H,LOC
Q
;
KILL I '$D(^DVB(396,MB,0)) K ^DVB(396,"F",MA,MB)
I $D(^DVB(396,MB,0)) DO
.S X1=PDATE,X2=MA D ^%DTC I X>0 S DA=MB,DIK="^DVB(396," D ^DIK K DIK,DA
Q
DATE S X1=DT,X2=HIST,X2=-X2 D C^%DTC S PDATE=X
Q
PART2 ;for NOTICE OF DISCHARGE file--^DVB(396.2
S HIST=30 D DATE
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
Q
;
KILL2 I '$D(^DVB(396.2,NODE)) K ^DVB(396.2,"C",LOC,"P",NODE) Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBARPUR 1245 printed Dec 13, 2024@01:42:07 Page 2
DVBARPUR ;557/THM-PURGE AMIE FILES ;21 JUL 89
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;NOTE: This program was designed to run on the TaskManager. There is
+3 ; no output at all. It will, however, run real-time, if desired.
+4 ;
SETUP ;no parameters set
DO NOPARM^DVBAUTL2
if $DATA(DVBAQUIT)
GOTO EXIT
+1 IF '$DATA(DT)
SET X="T"
DO ^%DT
SET DT=Y
+2 ;
PART1 ;for 7131 file--^DVB(396,
+1 ;IF NOTHING SET, KEEP 60 DAYS
SET HIST=$SELECT($PIECE(^DVB(396.1,1,0),U,10)]"":$PIECE(^(0),U,10),1:60)
+2 DO DATE
GO SET MA=""
FOR I=0:0
SET MA=$ORDER(^DVB(396,"F",MA))
if MA=""
QUIT
SET MB=""
FOR J=0:0
SET MB=$ORDER(^DVB(396,"F",MA,MB))
if MB=""
QUIT
DO KILL
+1 DO PART2
+2 ;
EXIT KILL DVBAQUIT,NODE,DIK,X,Y,MA,MB,I,J,DA,PDATE,X1,X2,HIST,%,%DT,%H,LOC
+1 QUIT
+2 ;
KILL IF '$DATA(^DVB(396,MB,0))
KILL ^DVB(396,"F",MA,MB)
+1 IF $DATA(^DVB(396,MB,0))
Begin DoDot:1
+2 SET X1=PDATE
SET X2=MA
DO ^%DTC
IF X>0
SET DA=MB
SET DIK="^DVB(396,"
DO ^DIK
KILL DIK,DA
End DoDot:1
+3 QUIT
DATE SET X1=DT
SET X2=HIST
SET X2=-X2
DO C^%DTC
SET PDATE=X
+1 QUIT
PART2 ;for NOTICE OF DISCHARGE file--^DVB(396.2
+1 SET HIST=30
DO DATE
+2 FOR LOC=0:0
SET LOC=$ORDER(^DVB(396.2,"C",LOC))
if LOC=""
QUIT
FOR NODE=0:0
SET NODE=$ORDER(^DVB(396.2,"C",LOC,"P",NODE))
if NODE=""
QUIT
DO KILL2
+3 QUIT
+4 ;
KILL2 IF '$DATA(^DVB(396.2,NODE))
KILL ^DVB(396.2,"C",LOC,"P",NODE)
QUIT
+1 SET X1=PDATE
SET X2=$PIECE(^DVB(396.2,NODE,0),U,5)
DO ^%DTC
IF X>0
SET DA=NODE
SET DIK="^DVB(396.2,"
DO ^DIK
KILL DIK,DA
+2 QUIT
