source: WorldVistAEHR/trunk/r/PAID-PRS/PRSASC.m

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PRSASC ; HISC/MGD - Supervisor Certification ;01/22/05
2 ;;4.0;PAID;**15,43,93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?28,"SUPERVISOR'S APPROVALS"
5 S PRSTLV=3 D ^PRSAUTL G:TLI<1 EX S QT=0
6 S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3) K AP
7 S OTS=";"_$P(^DD(458.2,10,0),"^",3)
8 S EDS=";"_$P(^DD(458.3,8,0),"^",3)
9 S NN="",CKS=1 F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 D CHK I QT G ES
10 S CKS=0 F VA2=0:0 S VA2=$O(^PRST(455.5,"ASX",TLE,VA2)) Q:VA2<1 S SSN=$P($G(^VA(200,VA2,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) I DFN,$P($G(^PRSPC(+DFN,0)),"^",8)'=TLE D CHK I QT G ES
11ES I '$D(AP) W !!,"No actions to certify." G EX
12 D ^PRSAES G:'ESOK EX
13 ; Queue approvals
14 K ZTUCI,ZTDTH,ZTIO,ZTSAVE S ZTRTN="^PRSASC1",ZTREQ="@",ZTIO="",ZTDTH=$H
15 S ZTSAVE("ZTREQ")="",ZTSAVE("AP(")="",ZTSAVE("ESNAM")="",ZTDESC=$P(XQY0,"^",1)
16 S ZTSAVE("TLI")="",ZTSAVE("TLE")=""
17 D ^%ZTLOAD W !,"Approvals Queued",! G EX
18CHK ; Check for needed approvals
19 S HDR=0 I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ))
20 E I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE
21 F DA=0:0 S DA=$O(^PRST(458.1,"AR",DFN,DA)) Q:DA<1 D LV G:QT C1
22 F DA=0:0 S DA=$O(^PRST(458.2,"AR",DFN,DA)) Q:DA<1 D OT G:QT C1
23 F DA=0:0 S DA=$O(^PRST(458.3,"AR",DFN,DA)) Q:DA<1 D ED G:QT C1
24 I $D(^PRST(458,"ATC",DFN)) F PPI=0:0 S PPI=$O(^PRST(458,"ATC",DFN,PPI)) Q:PPI<1 S DA=DFN_"~"_PPI D TC G:QT C1
25 I $D(^PRST(458,"AXR",DFN)) F PPI=0:0 S PPI=$O(^PRST(458,"AXR",DFN,PPI)) Q:PPI<1 F AUN=0:0 S AUN=$O(^PRST(458,"AXR",DFN,PPI,AUN)) Q:AUN<1 S DA=DFN_"~"_PPI_"~"_AUN D PP G:QT C1
26C1 Q
27LV ; Leave Request
28 N PRSX
29 D:'HDR HDR S (NUM,CNT)=0,PRT=1 W ! D BAL^PRSALVS W ! D LST^PRSALVS
30 S PRSX=$$OKALVR^PRSPLVU(DA)
31 I PRSX'>0 D
32 . W !!,"This leave request can not be approved because the employee is"
33 . W !,"a part-time physician with a memorandum of service level"
34 . W !,"expectations, and the leave request may impact a time card for"
35 . W !,"pay period "_$P($G(^PRST(458,+$P(PRSX,U,2),0)),U)_" that has a status of Payroll."
36 . W !,"The request can be approved once the time card status changes."
37 . W !,"(i.e. returned to Timekeeper or transmitted to Austin)",!
38 S COM="" D LVOK Q:QT
39 I ACT="A",PRSX'>0 W !,"Approved action can't be accepted at this time" Q
40 S:ACT'="" AP(1,DA)=DFN_"^"_ACT_"^"_COM
41 Q
42OT ; Overtime/CompTime Request
43 D:'HDR HDR S (NUM,CNT)=0 W ! D LST^PRSAOTS S COM="" D OK Q:QT I ACT'="" S:ACT="A" ACT="S" S AP(2,DA)=DFN_"^"_ACT_"^"_COM
44 Q
45ED ; Environmental Diff. Request
46 D:'HDR HDR S (NUM,CNT)=0 W ! D LST^PRSAEDS S COM="" D OK Q:QT S:ACT'="" AP(3,DA)=DFN_"^"_ACT_"^"_COM Q
47TC ; Tour Change
48 D:'HDR HDR D LST^PRSATE1 K COM D OK Q:QT S:ACT'="" AP(4,DA)=DFN_"^"_ACT Q
49PP ; Prior Pay Period Change
50 D:'HDR HDR D DIS^PRSASC3 K COM D OK Q:QT I ACT'="" S:ACT="A" ACT="S" S AP(5,DA)=DFN_"^"_ACT
51 Q
52OK R !!,"Disposition (A=Approve, D=Disapprove, X=Cancel, RETURN to bypass): ",ACT:DTIME S:'$T!(ACT["^") QT=1 Q:QT!(ACT="") S ACT=$TR(ACT,"adx","ADX") I ACT'?1U!("ADX"'[ACT) W *7,!,"Enter A, D or X or Press RETURN to bypass" G OK
53 Q:'$D(COM) S COM=""
54O1 I ACT'="A" R !!,"Comment: ",COM:DTIME S:'$T!(COM["^") QT=1 Q:QT I COM'?.ANP W *7," ??" G O1
55 I ACT'="A",$L(COM)<4!($L(COM)>60)!(COM?1"?".E) W *7," A 4-60 character comment is required." G O1
56 Q
57 ;
58LVOK N PROMPT,REPROMPT
59 S PROMPT="Disposition (A=Approve, D=Disapprove, RETURN to bypass): "
60 S REPROMPT="Enter A or D or Press RETURN to bypass"
61 W !!,PROMPT
62 R ACT:DTIME
63 S:'$T!(ACT["^") QT=1
64 Q:QT!(ACT="")
65 S ACT=$TR(ACT,"ad","AD")
66 I ACT'?1U!("AD"'[ACT) W *7,!,REPROMPT G LVOK
67 Q:'$D(COM) S COM=""
68 D O1
69 Q
70 ;
71HDR ; Display Header
72 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?28,"SUPERVISOR'S APPROVALS"
73 S PPE="" D HDR^PRSADP1 S HDR=1 Q
74EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.