34 lines
1.1 KiB
Mathematica
34 lines
1.1 KiB
Mathematica
DGYWPOST ;ALB/MLI - Post-init for EDR clean-up patch DG*5.3*65 ; 14 Aug 95 [10/12/95 4:27pm]
|
|
;;5.3;Registration;**65**;Aug 13, 1993
|
|
;
|
|
; This routine will re-index the B and ABDC cross-references on the PIMS
|
|
; EDR EVENT file (#391.51). It will also kick off the job to run a
|
|
; diagnostic check of the file.
|
|
;
|
|
EN ; post-init start
|
|
D REINDEX
|
|
D CENSUS
|
|
D QUEUE^VAFEDRCU ; queue edr clean-up
|
|
Q
|
|
;
|
|
;
|
|
REINDEX ; re-indexes B and ABDC cross-references
|
|
W !!,">>> Re-indexing B and ABDC cross-references on file 391.51..."
|
|
K ^VAT(391.51,"B"),^("ABDC") ; kill indexes
|
|
S DIK="^VAT(391.51,",DIK(1)=".01^B^ABDC1" D ENALL^DIK ; reindexes B and ABDC
|
|
W "Done",!!
|
|
Q
|
|
;
|
|
;
|
|
CENSUS ; puts census PTFs into 391.51
|
|
W !,">>> Placing census PTF records into PIMS EDR EVENT file..."
|
|
N DGCOUNT,DGDATE,DGIEN,DA
|
|
S DGCOUNT=0,DGDATE=2950900
|
|
F S DGDATE=$O(^DGP(45.83,"AP",DGDATE)) Q:'DGDATE D
|
|
. F DGIEN=0:0 S DGIEN=$O(^DGP(45.83,"AP",DGDATE,DGIEN)) Q:'DGIEN D
|
|
. . F DA=0:0 S DA=$O(^DGP(45.83,"AP",DGDATE,DGIEN,DA)) Q:'DA D
|
|
. . . I $P($G(^DGPT(DA,0)),"^",11)'=2 Q
|
|
. . . S DGCOUNT=DGCOUNT+1 I '(DGCOUNT#30) W "."
|
|
. . . D EN^VAFEDG
|
|
Q
|