source: FOIAVistA/trunk/r/PAID-PRS/PRS8.m@ 1590

Last change on this file since 1590 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1PRS8 ;HISC/MRL,WIRMFO/JAH-DECOMPOSITION, PROCESSOR ;01/30/2007
2 ;;4.0;PAID;**22,111**;Sep 21, 1995;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This is the routine which is used to start the decomposition
6 ;process. There are several entry points which allow one to
7 ;process either an entire T&L, all entries or a single person.
8 ;Once the decision is made as to which entries to process the
9 ;routine ^PRS8DR is called and everything starts running.
10 ;
11 D DT^DICRW,HOME^%ZIS S DIK="^DOPT(""PRS8"","
12 G OPT:$D(^DOPT("PRS8",3)) K ^DOPT("PRS8")
13 S ^DOPT("PRS8",0)="PAID Decomposition Option"
14 F I=1:1 S X=$T(@I) Q:X']"" D
15 .S ^DOPT("PRS8",I,0)=$P(X,";",3)
16 .S ^DOPT("PRS8","B",$P(X,";",3),I)=""
17 D IXALL^DIK
18 ;
19OPT ; --- option selection
20 W !! S DIC="^DOPT(""PRS8"",",DIC(0)="EAQM" D ^DIC
21 I Y>0 S SEE=1 D @+Y G OPT
22 G ^PRS8CV
23 ;
241 ;;EMPLOYEE
25 W @IOF,!?21,"DECOMPOSE TIME FOR A SPECIFIC EMPLOYEE",!
2611 S (SEE,SAVE)=1,DIC("A")="Select Desired PAY PERIOD: "
27 D PY I 'OK D ^PRS8CV Q
2812 S DIC("A")="Decompose Time for which EMPLOYEE? "
29 D EMP G 11:'OK,12:OK<0
30 S (OK,SEE)=1 D EXIST G 12:'OK
31 D PRINT
32 G 12 ;ask for another
33 ;
342 ;;T&L DECOMPOSITION
35 W @IOF,!?35,"DECOMPOSE TIME FOR A T&L",!
36 D ^PRS8TL Q
37 ;
383 ;;VIEW
39 W @IOF,!?22,"VIEW DECOMPOSED TIME FOR A SPECIFIC EMPLOYEE",!
40 S SAVE=0,SEE=1 G 11
41 ;
42DFN ; --- entry point where DFN and PY are defined
43 N %
44 S DFN=$G(DFN),PY=$G(PY)
45 D CKPY Q:'OK
46 D CKDFN Q:OK'>0
47 S SEE=+$G(SEE)
48 S SAVE=+$G(SAVE)
49 G ^PRS8DR
50 ;
51PY ; --- select pay period to decompose
52 W ! S DIC="^PRST(458,",DIC(0)="AEQMZ" D ^DIC
53 S PY=+Y K DIC
54 ;
55CKPY ; --- entry point for checking PY variable
56 S (E,OK)=0,PY=+$G(PY) D
57 .I '$D(^PRST(458,+PY,0)) S E=1 Q ;no/invalid pp
58 .S PPD=$G(^PRST(458,+PY,1)) I 'PPD S E=2 Q ;no/invalid days node
59 .S X1=+PPD,X2=-14 D C^%DTC S PRS8D=X
60 .S X=$G(^PRST(458,"AD",X)),PPD(0)=+X,PPD(1)=$G(^PRST(458,+X,1)) ;last pp dates
61 .S X1=+PPD,X2=14 D C^%DTC ;15th day
62 .S X=$G(^PRST(458,"AD",X)),PPD(15)=+X
63 .S OK=1 D EN^PRS8HD K HO,PRS8D
64 I 'OK,E,PY'=-1 D NOPE
65 Q
66 ;
67EMP ; --- select employee
68 W ! S DIC="^PRSPC(",DIC(0)="AEQMZ" D ^DIC
69 S OK=0,DFN=+Y K DIC Q:DFN'>0 S OK=1
70 ;
71CKDFN ; --- entry point for checking DFN
72 S E=0,DFN=+$G(DFN)
73 S:'$D(^PRSPC(+DFN,0)) E=3
74 S:'$D(^PRST(458,+PY,"E",+DFN,0)) E=4
75 I E,DFN'=-1 D NOPE
76 Q
77 ;
78ONE ; --- entry point for decomposing a single entry (non-inteactive)
79 N %,DA
80 S SEE=0,SAVE=1,PY=+$G(PPI)
81 D CKPY G END:'OK
82 D CKDFN G END:'OK
83 D ^PRS8DR G END
84 ;
85PRINT ; --- where do I display this
86 S PRS8("PGM")="1^PRS8DR",PRS8("VAR")="DFN^PY^SAVE^SEE^PPD^PPD(^HD(",PRS8("DES")="Single Employee Descomposition" D DEV^PRS8UT
87 K PRS8 Q
88 ;
89EXIST ; --- check to see if data exists and show
90 K VAL,VALOLD S VALOLD=$G(^PRST(458,+PY,"E",+DFN,5)) Q:VALOLD=""
91 D ^PRSAENT,^PRS8VW ;show existing data
92 S TMTD=$G(^PRST(458,+PY,"E",DFN,0)),TMTD=$S($P(TMTD,"^",2)="X":1,1:0)
93 W !!,"The above data already exists from a previous decomposition. You may decompose"
94 W !,"again at this time to identify any changes. Since this "
95 I TMTD W "record has been TRANSMITTED",!,"already the original record will not be overwritten!!" Q
96 E W "is a",$S(SAVE:"n EDIT",1:" VIEW")," option",!,"running the decomposition WILL ",$S('SAVE:"NOT ",1:""),"overwrite existing information!"
97 ;
98DECOM ; --- decompose again
99 W !!,"Do you wish to run the decomposition" S %=2 D YN^DICN
100 I % S OK=$S(%=1:1,1:0) Q
101 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
102 ;
103NOPE ; --- can't process
104 Q:'E S ER(+E)=$P($T(ER+E),";;",2) W:SEE !?4,ER(+E),$C(7) S OK=0 Q
105 ;
106END ; --- all done here/kill variables
107 Q
108 ;
109AUTOPINI(PPIEN,EMPIEN,PRIOR,PRVAL) ; initialize auto-posted data
110 ; This call backs out auto-posted data from the time card (if any)
111 ; inputs
112 ; PPIEN = pay period IEN (file 458)
113 ; EMPIEN = employee IEN (file 450, sub-file 458.01)
114 ; PRIOR = optional flag, true (=1) to return original data
115 ; PRVAL = optional array, required if PRIOR true
116 ; passed by reference
117 ; contains the original data (before removal) in the format
118 ; PRVAL(day number,node number)=value of node
119 ; if no auto-posted data then array would be undefined
120 ;
121 N DAY,NODE,TOUR
122 I $G(PRIOR) K PRVAL
123 ;
124 ; loop thru days of employee time card
125 S DAY=0 F S DAY=$O(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY)) Q:DAY="" D
126 . ; quit if day not auto-posted (DUZ not = .5 POSTMASTER)
127 . Q:$P($G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,10)),"^",2)'=.5
128 . ;
129 . ; if PRIOR true then save the current data
130 . I $G(PRIOR) F NODE=2,3,10 D
131 . . S PRVAL(DAY,NODE)=$G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE))
132 . ;
133 . ; determine tour of duty
134 . S TOUR=$P($G(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,0)),"^",2)
135 . ;
136 . ; if day off then delete auto-posted data else restore day to HX
137 . I TOUR=1 K ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),^(3),^(10)
138 . E D
139 . . S $P(^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,2),"^",3)="HX"
140 . . K ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,3)
141 Q
142 ;
143AUTOPRES(PPIEN,EMPIEN,PRVAL) ; restore auto-posted data
144 ; This call restores original auto-posted data that was initialized
145 ; by AUTOPINI. See AUTOPINI for description of inputs.
146 ;
147 N DAY,NODE
148 ;
149 ; loop thru days with auto-posted data
150 S DAY=0 F S DAY=$O(PRVAL(DAY)) Q:'DAY D
151 . ; loop thru nodes and restore original data
152 . F NODE=2,3,10 I $D(PRVAL(DAY,NODE)) D
153 . . S ^PRST(458,PPIEN,"E",EMPIEN,"D",DAY,NODE)=PRVAL(DAY,NODE)
154 Q
155 ;
156ER ; error messages
157 ;;Invalid/Missing Pay Period passed (variable PY)
158 ;;The 1 node for the Pay Period is missing but needed to process
159 ;;Employee does not exist in Employee (450) file
160 ;;Employee has no timekeeping record for requested Pay Period
Note: See TracBrowser for help on using the repository browser.