Released PRS*4*124 SEQ #117 Extracted from mail message **KIDS**:PRS*4.0*124^ **INSTALL NAME** PRS*4.0*124 "BLD",8192,0) PRS*4.0*124^PAID^0^3110127^y "BLD",8192,1,0) ^^3^3^3110127^ "BLD",8192,1,1,0) This patch addresses 2 issues: "BLD",8192,1,2,0) 1. Employees are able to certify own timecard without security key "BLD",8192,1,3,0) 2. Site is unable to change an intermittent employee's time card "BLD",8192,4,0) ^9.64PA^^ "BLD",8192,6.3) 9 "BLD",8192,"KRN",0) ^9.67PA^779.2^20 "BLD",8192,"KRN",.4,0) .4 "BLD",8192,"KRN",.401,0) .401 "BLD",8192,"KRN",.402,0) .402 "BLD",8192,"KRN",.403,0) .403 "BLD",8192,"KRN",.5,0) .5 "BLD",8192,"KRN",.84,0) .84 "BLD",8192,"KRN",3.6,0) 3.6 "BLD",8192,"KRN",3.8,0) 3.8 "BLD",8192,"KRN",9.2,0) 9.2 "BLD",8192,"KRN",9.8,0) 9.8 "BLD",8192,"KRN",9.8,"NM",0) ^9.68A^4^2 "BLD",8192,"KRN",9.8,"NM",3,0) PRSATPP^^0^B14403687 "BLD",8192,"KRN",9.8,"NM",4,0) PRSAPPX^^0^B8495395 "BLD",8192,"KRN",9.8,"NM","B","PRSAPPX",4) "BLD",8192,"KRN",9.8,"NM","B","PRSATPP",3) "BLD",8192,"KRN",19,0) 19 "BLD",8192,"KRN",19.1,0) 19.1 "BLD",8192,"KRN",101,0) 101 "BLD",8192,"KRN",409.61,0) 409.61 "BLD",8192,"KRN",771,0) 771 "BLD",8192,"KRN",779.2,0) 779.2 "BLD",8192,"KRN",870,0) 870 "BLD",8192,"KRN",8989.51,0) 8989.51 "BLD",8192,"KRN",8989.52,0) 8989.52 "BLD",8192,"KRN",8994,0) 8994 "BLD",8192,"KRN","B",.4,.4) "BLD",8192,"KRN","B",.401,.401) "BLD",8192,"KRN","B",.402,.402) "BLD",8192,"KRN","B",.403,.403) "BLD",8192,"KRN","B",.5,.5) "BLD",8192,"KRN","B",.84,.84) "BLD",8192,"KRN","B",3.6,3.6) "BLD",8192,"KRN","B",3.8,3.8) "BLD",8192,"KRN","B",9.2,9.2) "BLD",8192,"KRN","B",9.8,9.8) "BLD",8192,"KRN","B",19,19) "BLD",8192,"KRN","B",19.1,19.1) "BLD",8192,"KRN","B",101,101) "BLD",8192,"KRN","B",409.61,409.61) "BLD",8192,"KRN","B",771,771) "BLD",8192,"KRN","B",779.2,779.2) "BLD",8192,"KRN","B",870,870) "BLD",8192,"KRN","B",8989.51,8989.51) "BLD",8192,"KRN","B",8989.52,8989.52) "BLD",8192,"KRN","B",8994,8994) "BLD",8192,"QDEF") ^^^^^^^^^^YES "BLD",8192,"QUES",0) ^9.62^^ "BLD",8192,"REQB",0) ^9.611^1^1 "BLD",8192,"REQB",1,0) PRS*4.0*117^2 "BLD",8192,"REQB","B","PRS*4.0*117",1) "MBREQ") 0 "PKG",408,-1) 1^1 "PKG",408,0) PAID^PRS^PAID "PKG",408,20,0) ^9.402P^^ "PKG",408,22,0) ^9.49I^1^1 "PKG",408,22,1,0) 4.0^2950912^2960130 "PKG",408,22,1,"PAH",1,0) 124^3110127 "PKG",408,22,1,"PAH",1,1,0) ^^3^3^3110127 "PKG",408,22,1,"PAH",1,1,1,0) This patch addresses 2 issues: "PKG",408,22,1,"PAH",1,1,2,0) 1. Employees are able to certify own timecard without security key "PKG",408,22,1,"PAH",1,1,3,0) 2. Site is unable to change an intermittent employee's time card "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRSAPPX") 0^4^B8495395^B7155774 "RTN","PRSAPPX",1,0) PRSAPPX ; HISC/REL-Approve Prior Pay Period Changes ;9/21/95 15:23 "RTN","PRSAPPX",2,0) ;;4.0;PAID;**124**;Sep 21, 1995;Build 9 "RTN","PRSAPPX",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRSAPPX",4,0) K ^TMP($J) "RTN","PRSAPPX",5,0) F DFN=0:0 S DFN=$O(^PRST(458,"AXS",DFN)) Q:DFN<1 F PPI=0:0 S PPI=$O(^PRST(458,"AXS",DFN,PPI)) Q:PPI<1 D CHK "RTN","PRSAPPX",6,0) I '$D(^TMP($J)) S NF=0 G ES "RTN","PRSAPPX",7,0) K AP S QT=0,NF=1,TLE="" "RTN","PRSAPPX",8,0) F S TLE=$O(^TMP($J,TLE)) Q:TLE="" F DFN=0:0 S DFN=$O(^TMP($J,TLE,DFN)) Q:DFN<1 F PPI=0:0 S PPI=$O(^TMP($J,TLE,DFN,PPI)) Q:PPI<1 F AUN=0:0 S AUN=$O(^PRST(458,"AXS",DFN,PPI,AUN)) Q:AUN<1 D G:QT ES "RTN","PRSAPPX",9,0) .D HDR,DIS^PRSASC3 D OK Q:QT "RTN","PRSAPPX",10,0) .I ACT'="" S AP(5,DFN_"~"_PPI_"~"_AUN)=DFN_"^"_ACT "RTN","PRSAPPX",11,0) .Q "RTN","PRSAPPX",12,0) ES I '$D(^TMP($J)) W !!,$S('NF:"No Prior Pay Period actions to certify.",1:"No Prior Pay Period certification action taken.") G EX "RTN","PRSAPPX",13,0) D ^PRSAES G:'ESOK EX D NOW^%DTC S NOW=% "RTN","PRSAPPX",14,0) S NOD="AXS",NX="" F S NX=$O(AP(5,NX)) Q:NX="" D APP^PRSASC3 "RTN","PRSAPPX",15,0) G EX "RTN","PRSAPPX",16,0) CHK ; Check for needed approvals "RTN","PRSAPPX",17,0) N PRSSSSN,PRSESSN ;;Approving Supervisor SSN and Paid Employee SSN "RTN","PRSAPPX",18,0) S PRSSSSN=$P($G(^VA(200,DUZ,1)),U,9),PRSESSN=$P($G(^PRSPC(DFN,0)),U,9) "RTN","PRSAPPX",19,0) I PRSSSSN=PRSESSN,'$D(^XUSEC("PRSA SIGN",DUZ)) Q "RTN","PRSAPPX",20,0) D TLC Q "RTN","PRSAPPX",21,0) TLC ; Check T&L "RTN","PRSAPPX",22,0) S TLE=$E($G(^PRST(458,PPI,"E",DFN,5)),22,24) D:" "[TLE T1 Q:TLE="" "RTN","PRSAPPX",23,0) S TLI=$O(^PRST(455.5,"B",TLE,0)) D:TLI<1 T1 Q:TLI<1 I $D(^PRST(455.5,TLI,"A",DUZ)) S ^TMP($J,TLE,DFN,PPI)="" "RTN","PRSAPPX",24,0) Q "RTN","PRSAPPX",25,0) T1 S TLE=$P($G(^PRSPC(DFN,0)),"^",8) Q:TLE="" "RTN","PRSAPPX",26,0) S TLI=$O(^PRST(455.5,"B",TLE,0)) Q "RTN","PRSAPPX",27,0) OK 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 "RTN","PRSAPPX",28,0) Q "RTN","PRSAPPX",29,0) HDR ; Display Header "RTN","PRSAPPX",30,0) W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?26,"PRIOR PAY PERIOD CORRECTION" "RTN","PRSAPPX",31,0) S PPE="" D HDR^PRSADP1 S HDR=1 Q "RTN","PRSAPPX",32,0) EX S TLE="" F S TLE=$O(^TMP($J,TLE)) Q:TLE="" S TLI=$O(^PRST(455.5,"B",TLE,0)) D:TLI APP^PRSASAL "RTN","PRSAPPX",33,0) K ^TMP($J) G KILL^XUSCLEAN "RTN","PRSATPP") 0^3^B14403687^B14151243 "RTN","PRSATPP",1,0) PRSATPP ;WCIOFO/PLT - Timekeeper Prior PP Post Time ;7/29/08 15:44 "RTN","PRSATPP",2,0) ;;4.0;PAID;**117,124**;Sep 21, 1995;Build 9 "RTN","PRSATPP",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRSATPP",4,0) ; "RTN","PRSATPP",5,0) S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX "RTN","PRSATPP",6,0) S X=$P(^PRST(455.5,TLI,0),"^",3) D NOW^%DTC S NOW=%,DT=%\1 "RTN","PRSATPP",7,0) D1 S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT "RTN","PRSATPP",8,0) G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) "RTN","PRSATPP",9,0) I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX "RTN","PRSATPP",10,0) S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY) "RTN","PRSATPP",11,0) NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC "RTN","PRSATPP",12,0) G:DFN<1 EX "RTN","PRSATPP",13,0) D ^PRSAENT I ENT="" W *7,!!,"Employee has no Pay Entitlement table entry." G EX "RTN","PRSATPP",14,0) S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "T"[STAT W *7,!!,"Employee still open for regular posting." G NME "RTN","PRSATPP",15,0) I STAT'="X" W !!,*7,"Card in Payroll and not transmitted; request return of card." G NME "RTN","PRSATPP",16,0) K AUR S L2=0 F L1=0,1,2,10,3,4 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,L1)),L2=L2+1 S:Z'="" AUR(L2)=Z "RTN","PRSATPP",17,0) S STAT=$P($G(AUR(4)),"^",1) D POST "RTN","PRSATPP",18,0) S (Z,L2)=0 F L1=0,1,2,10,3,4 S L2=L2+1 I $G(^PRST(458,PPI,"E",DFN,"D",DAY,L1))'=$G(AUR(L2)) S Z=1 "RTN","PRSATPP",19,0) I Z S AUT="T",AUS="R" D ^PRSAUD I $G(AUR(7))["^" S L2=0 F L1=0,1,2,10,3,4 S L2=L2+1 K ^PRST(458,PPI,"E",DFN,"D",DAY,L1) I $D(AUR(L2)) S ^(L1)=AUR(L2) "RTN","PRSATPP",20,0) G NME "RTN","PRSATPP",21,0) ; "RTN","PRSATPP",22,0) POST ;start posting "RTN","PRSATPP",23,0) N DDSFILE,PRSDAY,PRSDN,PRSERR,SRT "RTN","PRSATPP",24,0) S SRT="X",PRSDN=DAY "RTN","PRSATPP",25,0) S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13) "RTN","PRSATPP",26,0) D ^PRSADP1,LP,^PRSATP2 G:'TC T1 "RTN","PRSATPP",27,0) T0 R !!,"Do you wish to change Scheduled Tour? N// ",X:DTIME Q:'$T!(X["^") S:X="" X="N" S X=$TR(X,"yesno","YESNO") "RTN","PRSATPP",28,0) I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G T0 "RTN","PRSATPP",29,0) G:X?1"N".E T3 "RTN","PRSATPP",30,0) T1 ; Get new tour "RTN","PRSATPP",31,0) S TYP=1,WTL=TLI "RTN","PRSATPP",32,0) S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="T&L on which Tour will be worked: ",DIC("B")=TLE W ! D ^DIC Q:Y<1 K DIC S WTL=+Y "RTN","PRSATPP",33,0) S DIC="^PRST(457.1,",DIC(0)="AEQMN" "RTN","PRSATPP",34,0) S DIC("S")="I "_$S($E(ENT,1)="D":"Y<3",$P(C0,"^",10)=3:"Y>2!(Y=1)",1:"Y>5!(Y=1)")_",$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))" "RTN","PRSATPP",35,0) S DIC("A")="Select TOUR OF DUTY: " W ! D ^DIC K DIC G:Y'>0 T2 "RTN","PRSATPP",36,0) S TD=+Y "RTN","PRSATPP",37,0) ;tour overlap check "RTN","PRSATPP",38,0) K PRSDAY S PRSDAY(DAY)=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),U,1,4),$P(PRSDAY(DAY),U,2)=TD,$P(PRSDAY(DAY),U,6)=$P($G(^(0)),U,13),$P(PRSDAY(DAY),U,7,999)=$G(^(4)) "RTN","PRSATPP",39,0) D PPTDOL^PRSATE5(SRT,PPI,DFN,DAY,.PRSDAY,3) I $G(PRSERR) K PRSERR G T1 "RTN","PRSATPP",40,0) S Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6) D SET^PRSATE,HOL^PRSATE S TC=TD "RTN","PRSATPP",41,0) T2 ;ask secondary tour "RTN","PRSATPP",42,0) G:$E(ENT,1)="D" T21 "RTN","PRSATPP",43,0) S X=$$ASK2NDTR^PRSATE() G:X'="Y" T21 D "RTN","PRSATPP",44,0) . N TD,TC,TC2 "RTN","PRSATPP",45,0) . S TD=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",13) "RTN","PRSATPP",46,0) . I TD W !!,"Existing Second Tour ",$P($G(^PRST(457.1,TD,0)),"^",1)," is being deleted." D DELSTD^PRSATE4(PPI,DFN,DAY) "RTN","PRSATPP",47,0) . QUIT "RTN","PRSATPP",48,0) I $P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2)<6 W *7,!!,"A second Tour is not valid on this day." G T21 "RTN","PRSATPP",49,0) K PRSDAY,PRSERR D "RTN","PRSATPP",50,0) . N DAY "RTN","PRSATPP",51,0) . S DAY=PRSDN D P^PRSATE4 "RTN","PRSATPP",52,0) . QUIT "RTN","PRSATPP",53,0) ; "RTN","PRSATPP",54,0) T21 S DAY=PRSDN,TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TD=TC,TC2=$P($G(^(0)),"^",13) "RTN","PRSATPP",55,0) D ^PRSADP1,LP,^PRSATP2 "RTN","PRSATPP",56,0) T3 G P1^PRSATP:TC=1,P3^PRSATP:TC=4,P0^PRSATP "RTN","PRSATPP",57,0) ; "RTN","PRSATPP",58,0) LP W !!,"Enter '^' to bypass this employee." W ! Q "RTN","PRSATPP",59,0) EX G KILL^XUSCLEAN "VER") 8.0^22.0 "BLD",8192,6) ^117 **END** **END**