DG53P1025.m

DG53P1025 ;SLC/RM - Patch DG*5.3*1025 Post Install Utility Routine ; July 15,2020@11:27am

 ;;5.3;Registration;**1025**;Aug 13, 1993;Build 11

 ;

 ;

 ;ICR#   TYPE       REFERENCE TO

 ;-----  ----       ---------------------

 ;10141  Sup        XPDUTL

 ;10013  Sup        ENALL^DIK

 ;

 ; This POST install routine will re-index the ELIGIBILITY CHANGES #33.02

 ; multiple field .01 in the OTH ELIGIBILITY PATIENT file (#33)

 Q

 ;

EN ;Post install entry point

 ;

 I $D(^DGOTH(33,"F")) D  Q   ;don't re-index if "F" already exists

 . D BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' x-ref already exist.")

 . D BMES^XPDUTL(" No re-indexing necessary.")

 . D BMES^XPDUTL(" ")

 ;

 N DIK,DA,MES

 D BMES^XPDUTL(" Please be patient while I re-index ""F"" cross reference on OTH ELIGIBILITY")

 D BMES^XPDUTL(" PATIENT file (#33)")

 I +$P(^DGOTH(33,0),U,4)<1 D  Q

 . S MES(1)="  "

 . S MES(2)=" ------------------"

 . S MES(3)="  "

 . S MES(4)=" No records found in the OTH ELIGIBILITY PATIENT file (#33)"

 . S MES(5)="  "

 . S MES(6)=" Nothing to re-index."

 . S MES(7)="  "

 . S MES(8)="  "

 . D MES^XPDUTL(.MES)

 ;Only want to reindex the "F" x-ref

 S DIK(1)=".01^F"

 ;global root for Eligibility Changes multiple

 S DIK="^DGOTH(33,DA(1),2,"

 ;loop through OTH ELIGIBILITY PATIENT file and index entries

 F DA(1)=0:0 S DA(1)=$O(^DGOTH(33,DA(1))) Q:DA(1)'>0  D ENALL^DIK

 I $D(^DGOTH(33,"F")) D  Q

 . D BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' cross reference indexing was completed successfully.")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53P1025   1563     printed  Apr 09, 2024@21:53:19                                                                                                                                                                                                   Page 2

DG53P1025 ;SLC/RM - Patch DG*5.3*1025 Post Install Utility Routine ; July 15,2020@11:27am

 +1       ;;5.3;Registration;**1025**;Aug 13, 1993;Build 11

 +2       ;

 +3       ;

 +4       ;ICR#   TYPE       REFERENCE TO

 +5       ;-----  ----       ---------------------

 +6       ;10141  Sup        XPDUTL

 +7       ;10013  Sup        ENALL^DIK

 +8       ;

 +9       ; This POST install routine will re-index the ELIGIBILITY CHANGES #33.02

 +10      ; multiple field .01 in the OTH ELIGIBILITY PATIENT file (#33)

 +11       QUIT 

 +12      ;

EN        ;Post install entry point

 +1       ;

 +2       ;don't re-index if "F" already exists

           IF $DATA(^DGOTH(33,"F"))

               Begin DoDot:1

 +3                DO BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' x-ref already exist.")

 +4                DO BMES^XPDUTL(" No re-indexing necessary.")

 +5                DO BMES^XPDUTL(" ")

               End DoDot:1

               QUIT 

 +6       ;

 +7        NEW DIK,DA,MES

 +8        DO BMES^XPDUTL(" Please be patient while I re-index ""F"" cross reference on OTH ELIGIBILITY")

 +9        DO BMES^XPDUTL(" PATIENT file (#33)")

 +10       IF +$PIECE(^DGOTH(33,0),U,4)<1

               Begin DoDot:1

 +11               SET MES(1)="  "

 +12               SET MES(2)=" ------------------"

 +13               SET MES(3)="  "

 +14               SET MES(4)=" No records found in the OTH ELIGIBILITY PATIENT file (#33)"

 +15               SET MES(5)="  "

 +16               SET MES(6)=" Nothing to re-index."

 +17               SET MES(7)="  "

 +18               SET MES(8)="  "

 +19               DO MES^XPDUTL(.MES)

               End DoDot:1

               QUIT 

 +20      ;Only want to reindex the "F" x-ref

 +21       SET DIK(1)=".01^F"

 +22      ;global root for Eligibility Changes multiple

 +23       SET DIK="^DGOTH(33,DA(1),2,"

 +24      ;loop through OTH ELIGIBILITY PATIENT file and index entries

 +25       FOR DA(1)=0:0

               SET DA(1)=$ORDER(^DGOTH(33,DA(1)))

               if DA(1)'>0

                   QUIT 

               DO ENALL^DIK

 +26       IF $DATA(^DGOTH(33,"F"))

               Begin DoDot:1

 +27               DO BMES^XPDUTL(" The OTH ELIGIBILITY PATIENT file (#33) 'F' cross reference indexing was completed successfully.")

               End DoDot:1

               QUIT 

 +28       QUIT 

 +29      ;