- 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 ---[H[J[2J[HPRSXP126 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