source: WorldVistAEHR/trunk/r/PAID-PRS/PRSASC3.m@ 1789

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRSASC3 ; HISC/REL,WOIFO/JAH - Supervisor Approve Prior PP Actions ;2/16/05
2 ;;4.0;PAID;**6,93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4DIS ; Display PP Action
5 N IFN
6 S Z=$G(^PRST(458,PPI,"E",DFN,"X",AUN,0)),TYP=$P(Z,"^",4) D DT:TYP="T",DV:TYP="V",DH:TYP="H"
7 I $D(^PRST(458,PPI,"E",DFN,"X",AUN,7)) W !!,"Change Remarks: ",^(7)
8 Q
9DT ; Display Time
10 S DAY=$P($G(^PRST(458,PPI,"E",DFN,"X",AUN,1)),"^",1) Q:'DAY
11 W !!,?28,"Prior Pay Period Change"
12 W !,?7,"Date",?21,"Scheduled Tour",?46,"Tour Exceptions"
13 W !?3,"------------------------------------------------------------------------"
14 S DTE=$P($G(^PRST(458,PPI,2)),"^",DAY) S IFN=AUN+1 D GET^PRSAPPP D F0^PRSAPPQ Q
15DV ; Display VCS/Fee changes
16 S PAYP=$P($G(^PRSPC(DFN,0)),"^",21)
17 S DTE=$P($G(^PRST(458,PPI,2)),"^",1)
18 W !!,$S(PAYP="F":"Fee Basis",1:"VCS Sales")," Adjustment for Pay Period beginning ",DTE
19 S IFN=AUN+1 D GET^PRSAPPP S Z=AUR(1) D VCS^PRSAPPQ Q
20DH ; Display ED changes
21 S DTE=$P($G(^PRST(458,PPI,2)),"^",1)
22 W !!,"Envir. Differential Adjustment for Pay Period beginning ",DTE
23 S IFN=AUN+1 D GET^PRSAPPP S Z=AUR(1) D ED^PRSAPPQ Q
24APP ; Approve PP Action
25 S DFN=$P(AP(5,NX),"^",1),ACT=$P(AP(5,NX),"^",2),PPI=$P(NX,"~",2),AUN=$P(NX,"~",3)
26 S Z=$G(^PRST(458,PPI,"E",DFN,"X",AUN,0)),$P(^(0),"^",5)=ACT
27 K ^PRST(458,NOD,DFN,PPI,AUN) S:"AS"[ACT ^PRST(458,"AX"_ACT,DFN,PPI,AUN)=""
28 ; if second level approver then recalculate PTP's Hours bank
29 I NOD="AXS" D
30 . S $P(^PRST(458,PPI,"E",DFN,"X",AUN,0),"^",8,9)=DUZ_"^"_NOW
31 . D PTP^PRSASR1(DFN,PPI)
32 I NOD="AXR" S $P(^PRST(458,PPI,"E",DFN,"X",AUN,0),"^",10,11)=DUZ_"^"_NOW
33 S TYP=$P(Z,"^",4) G AT:TYP="T",AV:TYP="V",AH:TYP="H"
34 Q
35AT ; Approve time
36 Q:"DX"'[ACT
37 ; If disapproved, un-do
38 S DAY=$P($G(^PRST(458,PPI,"E",DFN,"X",AUN,1)),"^",1) Q:'DAY
39 S IFN=AUN+1 D GET^PRSAPPP
40 I AUC N L2 S L2=0 F L1=0,1,2,10,3,4 S L2=L2+1 S Z=$G(^PRST(458,PPI,"E",DFN,"X",AUN,L2)) K ^PRST(458,PPI,"E",DFN,"D",DAY,L1) I Z'="" S ^(L1)=Z
41 ;if PTP corrected timecard is disapproved then call hrs bank API
42 ;since the unapproved work node for the corrected tc may have been
43 ;used in a call to the hours bank. Call will quit if not PTP w/memo
44 D PTP^PRSASR1(DFN,PPI)
45 Q
46AV ; Approve VCS/Fee Changes
47 I "DX"'[ACT S:ACT="S" $P(^PRST(458,PPI,"E",DFN,2),"^",17,18)=DUZ_"^"_NOW Q
48 ; If disapproved, un-do
49 S IFN=AUN+1 D GET^PRSAPPP
50 I AUC S Z=$G(^PRST(458,PPI,"E",DFN,"X",AUN,1)) K ^PRST(458,PPI,"E",DFN,2) S:Z'="" ^(2)=Z
51 Q
52AH ; Approve ED Changes
53 Q:"DX"'[ACT
54 ; if disapproved, un-do
55 S IFN=AUN+1 D GET^PRSAPPP
56 I AUC S Z=$G(^PRST(458,PPI,"E",DFN,"X",AUN,1)) K ^PRST(458,PPI,"E",DFN,4) S:Z'="" ^(4)=Z
57 Q
Note: See TracBrowser for help on using the repository browser.