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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYWPOST 1161 printed Sep 23, 2025@20:36:39 Page 2
DGYWPOST ;ALB/MLI - Post-init for EDR clean-up patch DG*5.3*65 ; 14 Aug 95 [10/12/95 4:27pm]
+1 ;;5.3;Registration;**65**;Aug 13, 1993
+2 ;
+3 ; This routine will re-index the B and ABDC cross-references on the PIMS
+4 ; EDR EVENT file (#391.51). It will also kick off the job to run a
+5 ; diagnostic check of the file.
+6 ;
EN ; post-init start
+1 DO REINDEX
+2 DO CENSUS
+3 ; queue edr clean-up
DO QUEUE^VAFEDRCU
+4 QUIT
+5 ;
+6 ;
REINDEX ; re-indexes B and ABDC cross-references
+1 WRITE !!,">>> Re-indexing B and ABDC cross-references on file 391.51..."
+2 ; kill indexes
KILL ^VAT(391.51,"B"),^("ABDC")
+3 ; reindexes B and ABDC
SET DIK="^VAT(391.51,"
SET DIK(1)=".01^B^ABDC1"
DO ENALL^DIK
+4 WRITE "Done",!!
+5 QUIT
+6 ;
+7 ;
CENSUS ; puts census PTFs into 391.51
+1 WRITE !,">>> Placing census PTF records into PIMS EDR EVENT file..."
+2 NEW DGCOUNT,DGDATE,DGIEN,DA
+3 SET DGCOUNT=0
SET DGDATE=2950900
+4 FOR
SET DGDATE=$ORDER(^DGP(45.83,"AP",DGDATE))
if 'DGDATE
QUIT
Begin DoDot:1
+5 FOR DGIEN=0:0
SET DGIEN=$ORDER(^DGP(45.83,"AP",DGDATE,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:2
+6 FOR DA=0:0
SET DA=$ORDER(^DGP(45.83,"AP",DGDATE,DGIEN,DA))
if 'DA
QUIT
Begin DoDot:3
+7 IF $PIECE($GET(^DGPT(DA,0)),"^",11)'=2
QUIT
+8 SET DGCOUNT=DGCOUNT+1
IF '(DGCOUNT#30)
WRITE "."
+9 DO EN^VAFEDG
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
