PRSXP91 ;WCIOFO/MGD-CORRECT #457.5 ;01/26/2004
;;4.0;PAID;**91**;Sep 21, 1995
;
Q
;
; This program will correct two erroneous entries in the PAY
; ENTITLEMENT (#457.5) file (iens 64 & 106). It will then delete two
; other entries (iens 2 & 3) and repoint the ENTITLEMENT (#4) field of
; the EMPLOYEE (#458.01) multiple in the TIME & ATTENDACNE (#458) file
; to the correct entries (iens 64 & 106).
;
START ; Define variables
;
N DA,DATA,DIE,DIK,DR,EMP,ENT,IENS,PPI,PRSFDA,PRSIEN,U
S U="^"
; Delete extra entries (iens 2 & 3).
;
S DIK="^PRST(457.5,",DA=2 D ^DIK
S DIK="^PRST(457.5,",DA=3 D ^DIK
;
; Correct entries (iens 64 & 106).
;
S DATA="N 3 E PAY BASIS=$",DR=".01///^S X=DATA",DIE="^PRST(457.5,",DA=64
D ^DIE
S DATA="N3E$",DR="1///^S X=DATA",DIE="^PRST(457.5,",DA=64
D ^DIE
;
S DATA="N 3 N PAY BASIS=$",DR=".01///^S X=DATA",DIE="^PRST(457.5,",DA=106
D ^DIE
S DATA="N3N$",DR="1///^S X=DATA",DIE="^PRST(457.5,",DA=106
D ^DIE
;
; Loop through PP 04-01 and re-point as ENTITLEMENT (#4) fields as
; necessary.
; Re-point 2 to 64
; Re-point 3 to 106
;
S PPI=0
S PPI=$O(^PRST(458,"B","04-01",PPI))
Q:PPI=""
S EMP=0
F S EMP=$O(^PRST(458,PPI,"E",EMP)) Q:'EMP D
. S ENT=$P($G(^PRST(458,PPI,"E",EMP,0)),U,5)
. Q:ENT'=2&(ENT'=3)
. I ENT=2 D
. . S IENS=EMP_","_PPI_","
. . S PRSFDA(458.01,IENS,4)=64
. . S PRSIEN=EMP
. . D UPDATE^DIE("","PRSFDA","PRSIEN")
. I ENT=3 D
. . S IENS=EMP_","_PPI_","
. . S PRSFDA(458.01,IENS,4)=106
. . S PRSIEN=EMP
. . D UPDATE^DIE("","PRSFDA","PRSIEN")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP91 1592 printed Dec 13, 2024@02:29:06 Page 2
PRSXP91 ;WCIOFO/MGD-CORRECT #457.5 ;01/26/2004
+1 ;;4.0;PAID;**91**;Sep 21, 1995
+2 ;
+3 QUIT
+4 ;
+5 ; This program will correct two erroneous entries in the PAY
+6 ; ENTITLEMENT (#457.5) file (iens 64 & 106). It will then delete two
+7 ; other entries (iens 2 & 3) and repoint the ENTITLEMENT (#4) field of
+8 ; the EMPLOYEE (#458.01) multiple in the TIME & ATTENDACNE (#458) file
+9 ; to the correct entries (iens 64 & 106).
+10 ;
START ; Define variables
+1 ;
+2 NEW DA,DATA,DIE,DIK,DR,EMP,ENT,IENS,PPI,PRSFDA,PRSIEN,U
+3 SET U="^"
+4 ; Delete extra entries (iens 2 & 3).
+5 ;
+6 SET DIK="^PRST(457.5,"
SET DA=2
DO ^DIK
+7 SET DIK="^PRST(457.5,"
SET DA=3
DO ^DIK
+8 ;
+9 ; Correct entries (iens 64 & 106).
+10 ;
+11 SET DATA="N 3 E PAY BASIS=$"
SET DR=".01///^S X=DATA"
SET DIE="^PRST(457.5,"
SET DA=64
+12 DO ^DIE
+13 SET DATA="N3E$"
SET DR="1///^S X=DATA"
SET DIE="^PRST(457.5,"
SET DA=64
+14 DO ^DIE
+15 ;
+16 SET DATA="N 3 N PAY BASIS=$"
SET DR=".01///^S X=DATA"
SET DIE="^PRST(457.5,"
SET DA=106
+17 DO ^DIE
+18 SET DATA="N3N$"
SET DR="1///^S X=DATA"
SET DIE="^PRST(457.5,"
SET DA=106
+19 DO ^DIE
+20 ;
+21 ; Loop through PP 04-01 and re-point as ENTITLEMENT (#4) fields as
+22 ; necessary.
+23 ; Re-point 2 to 64
+24 ; Re-point 3 to 106
+25 ;
+26 SET PPI=0
+27 SET PPI=$ORDER(^PRST(458,"B","04-01",PPI))
+28 if PPI=""
QUIT
+29 SET EMP=0
+30 FOR
SET EMP=$ORDER(^PRST(458,PPI,"E",EMP))
if 'EMP
QUIT
Begin DoDot:1
+31 SET ENT=$PIECE($GET(^PRST(458,PPI,"E",EMP,0)),U,5)
+32 if ENT'=2&(ENT'=3)
QUIT
+33 IF ENT=2
Begin DoDot:2
+34 SET IENS=EMP_","_PPI_","
+35 SET PRSFDA(458.01,IENS,4)=64
+36 SET PRSIEN=EMP
+37 DO UPDATE^DIE("","PRSFDA","PRSIEN")
End DoDot:2
+38 IF ENT=3
Begin DoDot:2
+39 SET IENS=EMP_","_PPI_","
+40 SET PRSFDA(458.01,IENS,4)=106
+41 SET PRSIEN=EMP
+42 DO UPDATE^DIE("","PRSFDA","PRSIEN")
End DoDot:2
End DoDot:1
+43 QUIT
