DGYWPOST.m

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 ---DGYWPOST   1161     printed  Apr 09, 2024@21:48:10                                                                                                                                                                                                    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