PRS8 ;HISC/MRL,WIRMFO/JAH-DECOMPOSITION, PROCESSOR ;01/30/2007
;;4.0;PAID;**22,111**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This is the routine which is used to start the decomposition
;process. There are several entry points which allow one to
;process either an entire T&L, all entries or a single person.
;Once the decision is made as to which entries to process the
;routine ^PRS8DR is called and everything starts running.
;
D DT^DICRW,HOME^%ZIS S DIK="^DOPT(""PRS8"","
G OPT:$D(^DOPT("PRS8",3)) K ^DOPT("PRS8")
S ^DOPT("PRS8",0)="PAID Decomposition Option"
F I=1:1 S X=$T(@I) Q:X']"" D
.S ^DOPT("PRS8",I,0)=$P(X,";",3)
.S ^DOPT("PRS8","B",$P(X,";",3),I)=""
D IXALL^DIK
;
OPT ; --- option selection
W !! S DIC="^DOPT(""PRS8"",",DIC(0)="EAQM" D ^DIC
I Y>0 S SEE=1 D @+Y G OPT
G ^PRS8CV
;
1 ;;EMPLOYEE
W @IOF,!?21,"DECOMPOSE TIME FOR A SPECIFIC EMPLOYEE",!
11 S (SEE,SAVE)=1,DIC("A")="Select Desired PAY PERIOD: "
D PY I 'OK D ^PRS8CV Q
12 S DIC("A")="Decompose Time for which EMPLOYEE? "
D EMP G 11:'OK,12:OK<0
S (OK,SEE)=1 D EXIST G 12:'OK
D PRINT
G 12 ;ask for another
;
2 ;;T&L DECOMPOSITION
W @IOF,!?35,"DECOMPOSE TIME FOR A T&L",!
D ^PRS8TL Q
;
3 ;;VIEW
W @IOF,!?22,"VIEW DECOMPOSED TIME FOR A SPECIFIC EMPLOYEE",!
S SAVE=0,SEE=1 G 11
;
DFN ; --- entry point where DFN and PY are defined
N %
S DFN=$G(DFN),PY=$G(PY)
D CKPY Q:'OK
D CKDFN Q:OK'>0
S SEE=+$G(SEE)
S SAVE=+$G(SAVE)
G ^PRS8DR
;
PY ; --- select pay period to decompose
W ! S DIC="^PRST(458,",DIC(0)="AEQMZ" D ^DIC
S PY=+Y K DIC
;
CKPY ; --- entry point for checking PY variable
S (E,OK)=0,PY=+$G(PY) D
.I '$D(^PRST(458,+PY,0)) S E=1 Q ;no/invalid pp
.S PPD=$G(^PRST(458,+PY,1)) I 'PPD S E=2 Q ;no/invalid days node
.S X1=+PPD,X2=-14 D C^%DTC S PRS8D=X
.S X=$G(^PRST(458,"AD",X)),PPD(0)=+X,PPD(1)=$G(^PRST(458,+X,1)) ;last pp dates
.S X1=+PPD,X2=14 D C^%DTC ;15th day
.S X=$G(^PRST(458,"AD",X)),PPD(15)=+X
.S OK=1 D EN^PRS8HD K HO,PRS8D
I 'OK,E,PY'=-1 D NOPE
Q
;
EMP ; --- select employee
W ! S DIC="^PRSPC(",DIC(0)="AEQMZ" D ^DIC
S OK=0,DFN=+Y K DIC Q:DFN'>0 S OK=1
;
CKDFN ; --- entry point for checking DFN
S E=0,DFN=+$G(DFN)
S:'$D(^PRSPC(+DFN,0)) E=3
S:'$D(^PRST(458,+PY,"E",+DFN,0)) E=4
I E,DFN'=-1 D NOPE
Q
;
ONE ; --- entry point for decomposing a single entry (non-inteactive)
N %,DA
S SEE=0,SAVE=1,PY=+$G(PPI)
D CKPY G END:'OK
D CKDFN G END:'OK
D ^PRS8DR G END
;
PRINT ; --- where do I display this
S PRS8("PGM")="1^PRS8DR",PRS8("VAR")="DFN^PY^SAVE^SEE^PPD^PPD(^HD(",PRS8("DES")="Single Employee Descomposition" D DEV^PRS8UT
K PRS8 Q
;
EXIST ; --- check to see if data exists and show
K VAL,VALOLD S VALOLD=$G(^PRST(458,+PY,"E",+DFN,5)) Q:VALOLD=""
D ^PRSAENT,^PRS8VW ;show existing data
S TMTD=$G(^PRST(458,+PY,"E",DFN,0)),TMTD=$S($P(TMTD,"^",2)="X":1,1:0)
W !!,"The above data already exists from a previous decomposition. You may decompose"
W !,"again at this time to identify any changes. Since this "
I TMTD W "record has been TRANSMITTED",!,"already the original record will not be overwritten!!" Q
E W "is a",$S(SAVE:"n EDIT",1:" VIEW")," option",!,"running the decomposition WILL ",$S('SAVE:"NOT ",1:""),"overwrite existing information!"
;
DECOM ; --- decompose again
W !!,"Do you wish to run the decomposition" S %=2 D YN^DICN
I % S OK=$S(%=1:1,1:0) Q
W !?4,"Answer YES to rerun the decomposition process for this individual and ",$S('TMTD!('SAVE):"VIEW",1:"SAVE"),!?4,"the changes. Respond NO to QUIT now!" G DECOM
;
NOPE ; --- can't process
Q:'E S ER(+E)=$P($T(ER+E),";;",2) W:SEE !?4,ER(+E),$C(7) S OK=0 Q
;
END ; --- all done here/kill variables
Q
;
AUTOPINI(PPIEN,EMPIEN,PRIOR,PRVAL) ; initialize auto-posted data
; This call backs out auto-posted data from the time card (if any)
; inputs
; PPIEN = pay period IEN (file 458)
; EMPIEN = employee IEN (file 450, sub-file 458.01)
; PRIOR = optional flag, true (=1) to return original data
; PRVAL = optional array, required if PRIOR true
; passed by reference
; contains the original data (before removal) in the format
; PRVAL(day number,node number)=value of node
; if no auto-posted data then array would be undefined
;
N DAY,NODE,TOUR
I $G(PRIOR) K PRVAL
;
; loop thru days of employee time card
S DAY=0 F S DAY=$O(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY)) Q:DAY="" D
. ; quit if day not auto-posted (DUZ not = .5 POSTMASTER)
. Q:$P($G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,10)),"^",2)'=.5
. ;
. ; if PRIOR true then save the current data
. I $G(PRIOR) F NODE=2,3,10 D
. . S PRVAL(DAY,NODE)=$G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE))
. ;
. ; determine tour of duty
. S TOUR=$P($G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,0)),"^",2)
. ;
. ; if day off then delete auto-posted data else restore day to HX
. I TOUR=1 K ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),^(3),^(10)
. E D
. . S $P(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),"^",3)="HX"
. . K ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,3)
Q
;
AUTOPRES(PPIEN,EMPIEN,PRVAL) ; restore auto-posted data
; This call restores original auto-posted data that was initialized
; by AUTOPINI. See AUTOPINI for description of inputs.
;
N DAY,NODE
;
; loop thru days with auto-posted data
S DAY=0 F S DAY=$O(PRVAL(DAY)) Q:'DAY D
. ; loop thru nodes and restore original data
. F NODE=2,3,10 I $D(PRVAL(DAY,NODE)) D
. . S ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE)=PRVAL(DAY,NODE)
Q
;
ER ; error messages
;;Invalid/Missing Pay Period passed (variable PY)
;;The 1 node for the Pay Period is missing but needed to process
;;Employee does not exist in Employee (450) file
;;Employee has no timekeeping record for requested Pay Period
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8 5907 printed Sep 23, 2025@19:59:05 Page 2
PRS8 ;HISC/MRL,WIRMFO/JAH-DECOMPOSITION, PROCESSOR ;01/30/2007
+1 ;;4.0;PAID;**22,111**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This is the routine which is used to start the decomposition
+5 ;process. There are several entry points which allow one to
+6 ;process either an entire T&L, all entries or a single person.
+7 ;Once the decision is made as to which entries to process the
+8 ;routine ^PRS8DR is called and everything starts running.
+9 ;
+10 DO DT^DICRW
DO HOME^%ZIS
SET DIK="^DOPT(""PRS8"","
+11 if $DATA(^DOPT("PRS8",3))
GOTO OPT
KILL ^DOPT("PRS8")
+12 SET ^DOPT("PRS8",0)="PAID Decomposition Option"
+13 FOR I=1:1
SET X=$TEXT(@I)
if X']""
QUIT
Begin DoDot:1
+14 SET ^DOPT("PRS8",I,0)=$PIECE(X,";",3)
+15 SET ^DOPT("PRS8","B",$PIECE(X,";",3),I)=""
End DoDot:1
+16 DO IXALL^DIK
+17 ;
OPT ; --- option selection
+1 WRITE !!
SET DIC="^DOPT(""PRS8"","
SET DIC(0)="EAQM"
DO ^DIC
+2 IF Y>0
SET SEE=1
DO @+Y
GOTO OPT
+3 GOTO ^PRS8CV
+4 ;
1 ;;EMPLOYEE
+1 WRITE @IOF,!?21,"DECOMPOSE TIME FOR A SPECIFIC EMPLOYEE",!
11 SET (SEE,SAVE)=1
SET DIC("A")="Select Desired PAY PERIOD: "
+1 DO PY
IF 'OK
DO ^PRS8CV
QUIT
12 SET DIC("A")="Decompose Time for which EMPLOYEE? "
+1 DO EMP
if 'OK
GOTO 11
if OK<0
GOTO 12
+2 SET (OK,SEE)=1
DO EXIST
if 'OK
GOTO 12
+3 DO PRINT
+4 ;ask for another
GOTO 12
+5 ;
2 ;;T&L DECOMPOSITION
+1 WRITE @IOF,!?35,"DECOMPOSE TIME FOR A T&L",!
+2 DO ^PRS8TL
QUIT
+3 ;
3 ;;VIEW
+1 WRITE @IOF,!?22,"VIEW DECOMPOSED TIME FOR A SPECIFIC EMPLOYEE",!
+2 SET SAVE=0
SET SEE=1
GOTO 11
+3 ;
DFN ; --- entry point where DFN and PY are defined
+1 NEW %
+2 SET DFN=$GET(DFN)
SET PY=$GET(PY)
+3 DO CKPY
if 'OK
QUIT
+4 DO CKDFN
if OK'>0
QUIT
+5 SET SEE=+$GET(SEE)
+6 SET SAVE=+$GET(SAVE)
+7 GOTO ^PRS8DR
+8 ;
PY ; --- select pay period to decompose
+1 WRITE !
SET DIC="^PRST(458,"
SET DIC(0)="AEQMZ"
DO ^DIC
+2 SET PY=+Y
KILL DIC
+3 ;
CKPY ; --- entry point for checking PY variable
+1 SET (E,OK)=0
SET PY=+$GET(PY)
Begin DoDot:1
+2 ;no/invalid pp
IF '$DATA(^PRST(458,+PY,0))
SET E=1
QUIT
+3 ;no/invalid days node
SET PPD=$GET(^PRST(458,+PY,1))
IF 'PPD
SET E=2
QUIT
+4 SET X1=+PPD
SET X2=-14
DO C^%DTC
SET PRS8D=X
+5 ;last pp dates
SET X=$GET(^PRST(458,"AD",X))
SET PPD(0)=+X
SET PPD(1)=$GET(^PRST(458,+X,1))
+6 ;15th day
SET X1=+PPD
SET X2=14
DO C^%DTC
+7 SET X=$GET(^PRST(458,"AD",X))
SET PPD(15)=+X
+8 SET OK=1
DO EN^PRS8HD
KILL HO,PRS8D
End DoDot:1
+9 IF 'OK
IF E
IF PY'=-1
DO NOPE
+10 QUIT
+11 ;
EMP ; --- select employee
+1 WRITE !
SET DIC="^PRSPC("
SET DIC(0)="AEQMZ"
DO ^DIC
+2 SET OK=0
SET DFN=+Y
KILL DIC
if DFN'>0
QUIT
SET OK=1
+3 ;
CKDFN ; --- entry point for checking DFN
+1 SET E=0
SET DFN=+$GET(DFN)
+2 if '$DATA(^PRSPC(+DFN,0))
SET E=3
+3 if '$DATA(^PRST(458,+PY,"E",+DFN,0))
SET E=4
+4 IF E
IF DFN'=-1
DO NOPE
+5 QUIT
+6 ;
ONE ; --- entry point for decomposing a single entry (non-inteactive)
+1 NEW %,DA
+2 SET SEE=0
SET SAVE=1
SET PY=+$GET(PPI)
+3 DO CKPY
if 'OK
GOTO END
+4 DO CKDFN
if 'OK
GOTO END
+5 DO ^PRS8DR
GOTO END
+6 ;
PRINT ; --- where do I display this
+1 SET PRS8("PGM")="1^PRS8DR"
SET PRS8("VAR")="DFN^PY^SAVE^SEE^PPD^PPD(^HD("
SET PRS8("DES")="Single Employee Descomposition"
DO DEV^PRS8UT
+2 KILL PRS8
QUIT
+3 ;
EXIST ; --- check to see if data exists and show
+1 KILL VAL,VALOLD
SET VALOLD=$GET(^PRST(458,+PY,"E",+DFN,5))
if VALOLD=""
QUIT
+2 ;show existing data
DO ^PRSAENT
DO ^PRS8VW
+3 SET TMTD=$GET(^PRST(458,+PY,"E",DFN,0))
SET TMTD=$SELECT($PIECE(TMTD,"^",2)="X":1,1:0)
+4 WRITE !!,"The above data already exists from a previous decomposition. You may decompose"
+5 WRITE !,"again at this time to identify any changes. Since this "
+6 IF TMTD
WRITE "record has been TRANSMITTED",!,"already the original record will not be overwritten!!"
QUIT
+7 IF '$TEST
WRITE "is a",$SELECT(SAVE:"n EDIT",1:" VIEW")," option",!,"running the decomposition WILL ",$SELECT('SAVE:"NOT ",1:""),"overwrite existing information!"
+8 ;
DECOM ; --- decompose again
+1 WRITE !!,"Do you wish to run the decomposition"
SET %=2
DO YN^DICN
+2 IF %
SET OK=$SELECT(%=1:1,1:0)
QUIT
+3 WRITE !?4,"Answer YES to rerun the decomposition process for this individual and ",$SELECT('TMTD!('SAVE):"VIEW",1:"SAVE"),!?4,"the changes. Respond NO to QUIT now!"
GOTO DECOM
+4 ;
NOPE ; --- can't process
+1 if 'E
QUIT
SET ER(+E)=$PIECE($TEXT(ER+E),";;",2)
if SEE
WRITE !?4,ER(+E),$CHAR(7)
SET OK=0
QUIT
+2 ;
END ; --- all done here/kill variables
+1 QUIT
+2 ;
AUTOPINI(PPIEN,EMPIEN,PRIOR,PRVAL) ; initialize auto-posted data
+1 ; This call backs out auto-posted data from the time card (if any)
+2 ; inputs
+3 ; PPIEN = pay period IEN (file 458)
+4 ; EMPIEN = employee IEN (file 450, sub-file 458.01)
+5 ; PRIOR = optional flag, true (=1) to return original data
+6 ; PRVAL = optional array, required if PRIOR true
+7 ; passed by reference
+8 ; contains the original data (before removal) in the format
+9 ; PRVAL(day number,node number)=value of node
+10 ; if no auto-posted data then array would be undefined
+11 ;
+12 NEW DAY,NODE,TOUR
+13 IF $GET(PRIOR)
KILL PRVAL
+14 ;
+15 ; loop thru days of employee time card
+16 SET DAY=0
FOR
SET DAY=$ORDER(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY))
if DAY=""
QUIT
Begin DoDot:1
+17 ; quit if day not auto-posted (DUZ not = .5 POSTMASTER)
+18 if $PIECE($GET(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,10)),"^",2)'=.5
QUIT
+19 ;
+20 ; if PRIOR true then save the current data
+21 IF $GET(PRIOR)
FOR NODE=2,3,10
Begin DoDot:2
+22 SET PRVAL(DAY,NODE)=$GET(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE))
End DoDot:2
+23 ;
+24 ; determine tour of duty
+25 SET TOUR=$PIECE($GET(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,0)),"^",2)
+26 ;
+27 ; if day off then delete auto-posted data else restore day to HX
+28 IF TOUR=1
KILL ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),^(3),^(10)
+29 IF '$TEST
Begin DoDot:2
+30 SET $PIECE(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),"^",3)="HX"
+31 KILL ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,3)
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
AUTOPRES(PPIEN,EMPIEN,PRVAL) ; restore auto-posted data
+1 ; This call restores original auto-posted data that was initialized
+2 ; by AUTOPINI. See AUTOPINI for description of inputs.
+3 ;
+4 NEW DAY,NODE
+5 ;
+6 ; loop thru days with auto-posted data
+7 SET DAY=0
FOR
SET DAY=$ORDER(PRVAL(DAY))
if 'DAY
QUIT
Begin DoDot:1
+8 ; loop thru nodes and restore original data
+9 FOR NODE=2,3,10
IF $DATA(PRVAL(DAY,NODE))
Begin DoDot:2
+10 SET ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE)=PRVAL(DAY,NODE)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
ER ; error messages
+1 ;;Invalid/Missing Pay Period passed (variable PY)
+2 ;;The 1 node for the Pay Period is missing but needed to process
+3 ;;Employee does not exist in Employee (450) file
+4 ;;Employee has no timekeeping record for requested Pay Period
