| 1 | PRSASC3 ; 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.
|
|---|
| 4 | DIS ; 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
|
|---|
| 9 | DT ; 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
|
|---|
| 15 | DV ; 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
|
|---|
| 20 | DH ; 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
|
|---|
| 24 | APP ; 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
|
|---|
| 35 | AT ; 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
|
|---|
| 46 | AV ; 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
|
|---|
| 52 | AH ; 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
|
|---|
