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