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 Dec 13, 2024@02:28:51 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
