PRSXP126.m

PRSXP126 ;WOIFO/KJS PAID v4.0 Post-Initialization Routine ;12-9-2011

 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ; This routine contains the post-initialization code for PAID

 ; package v4.0. Patch 126

 ;

 Q

 ;

POST ;

 ;Reindex POC TIME AEP INDEX

 N DIK,DA

 S DIK="^PRSN(451,DA(1),""E"","

 S DIK(1)="1^AEP"

 S DA(1)=0

 F  S DA(1)=$O(^PRSN(451,DA(1))) Q:DA(1)'?1.N  D

 .D ENALL^DIK

 ;

 ;Reindex POC TIME ALN INDEX

 N DIK,DA

 S DIK="^PRSN(451,DA(4),""E"",DA(3),""D"",DA(2),""V"",DA(1),""T"","

 S DIK(1)="4^ALN"

 S DA(4)=0

 F  S DA(4)=$O(^PRSN(451,DA(4))) Q:DA(4)'?1.N  D

 .S DA(3)=0

 .F  S DA(3)=$O(^PRSN(451,DA(4),"E",DA(3))) Q:DA(3)'?1.N  D

 ..S DA(2)=0

 ..F  S DA(2)=$O(^PRSN(451,DA(4),"E",DA(3),"D",DA(2))) Q:DA(2)'?1.N  D

 ...S DA(1)=0

 ...F  S DA(1)=$O(^PRSN(451,DA(4),"E",DA(3),"D",DA(2),"V",DA(1))) Q:DA(1)'?1.N  D

 ....D ENALL^DIK

 ;

 N DA

 S DA=0

 F  S DA=$O(^PRSN(451.7,DA)) Q:'DA  D

 . N PRSFDA,IEN,PRSIEN,REC

 . S REC=^PRSN(451.7,DA,0),PRSIEN=$P(REC,U,6),TL=$P(^PRSPC(PRSIEN,0),U,8)

 . S PRSFDA(451.7,DA_",",15)=TL ; T&L

 . D UPDATE^DIE("","PRSFDA","IEN"),MSG^DIALOG()

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSXP126   1193     printed  Feb 18, 2025@23:55:23                                                                                                                                                                                                    Page 2

PRSXP126  ;WOIFO/KJS PAID v4.0 Post-Initialization Routine ;12-9-2011

 +1       ;;4.0;PAID;**126**;Sep 21, 1995;Build 59

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ; This routine contains the post-initialization code for PAID

 +5       ; package v4.0. Patch 126

 +6       ;

 +7        QUIT 

 +8       ;

POST      ;

 +1       ;Reindex POC TIME AEP INDEX

 +2        NEW DIK,DA

 +3        SET DIK="^PRSN(451,DA(1),""E"","

 +4        SET DIK(1)="1^AEP"

 +5        SET DA(1)=0

 +6        FOR 

               SET DA(1)=$ORDER(^PRSN(451,DA(1)))

               if DA(1)'?1.N

                   QUIT 

               Begin DoDot:1

 +7                DO ENALL^DIK

               End DoDot:1

 +8       ;

 +9       ;Reindex POC TIME ALN INDEX

 +10       NEW DIK,DA

 +11       SET DIK="^PRSN(451,DA(4),""E"",DA(3),""D"",DA(2),""V"",DA(1),""T"","

 +12       SET DIK(1)="4^ALN"

 +13       SET DA(4)=0

 +14       FOR 

               SET DA(4)=$ORDER(^PRSN(451,DA(4)))

               if DA(4)'?1.N

                   QUIT 

               Begin DoDot:1

 +15               SET DA(3)=0

 +16               FOR 

                       SET DA(3)=$ORDER(^PRSN(451,DA(4),"E",DA(3)))

                       if DA(3)'?1.N

                           QUIT 

                       Begin DoDot:2

 +17                       SET DA(2)=0

 +18                       FOR 

                               SET DA(2)=$ORDER(^PRSN(451,DA(4),"E",DA(3),"D",DA(2)))

                               if DA(2)'?1.N

                                   QUIT 

                               Begin DoDot:3

 +19                               SET DA(1)=0

 +20                               FOR 

                                       SET DA(1)=$ORDER(^PRSN(451,DA(4),"E",DA(3),"D",DA(2),"V",DA(1)))

                                       if DA(1)'?1.N

                                           QUIT 

                                       Begin DoDot:4

 +21                                       DO ENALL^DIK

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +22      ;

 +23       NEW DA

 +24       SET DA=0

 +25       FOR 

               SET DA=$ORDER(^PRSN(451.7,DA))

               if 'DA

                   QUIT 

               Begin DoDot:1

 +26               NEW PRSFDA,IEN,PRSIEN,REC

 +27               SET REC=^PRSN(451.7,DA,0)

                   SET PRSIEN=$PIECE(REC,U,6)

                   SET TL=$PIECE(^PRSPC(PRSIEN,0),U,8)

 +28      ; T&L

                   SET PRSFDA(451.7,DA_",",15)=TL

 +29               DO UPDATE^DIE("","PRSFDA","IEN")

                   DO MSG^DIALOG()

               End DoDot:1

 +30       QUIT