Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSASR

PRSASR.m

Go to the documentation of this file.
  1. PRSASR ;HISC/MGD,WOIFO/JAH/PLT - Supervisor Certification ;02/05/2005
  1. ;;4.0;PAID;**2,7,8,22,37,43,82,93,112,117,132**;Sep 21, 1995;Build 13
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;Called by Pay Per Cert Option on T&A Superv menu. Timecard 4 each
  1. ;employee in this supervs T&L is displayed. Superv prompted at each
  1. ;display as to whether card is ready 4 certification. Cards that r
  1. ;ready r saved in ^TMP. After this review--elect sign code is
  1. ;required to release approved cards to payroll. Upon ES
  1. ; 8b, exceptions, & ot warnings r stored & timecard status
  1. ;changed to 'P'--'released to payroll'
  1. ;
  1. ;=====================================================================
  1. ;
  1. ;Set up reverse video ON & OFF for tour error highlighting
  1. N IORVOFF,IORVON,IOINHI,IOINORM,IOBOFF,IOBON,RESP
  1. S X="IORVOFF;IORVON;IOBOFF;IOBON;IOINHI;IOINORM" D ENDR^%ZISS
  1. ;
  1. N MIDPP,DUMMY
  1. S MIDPP="In middle of Pay Period; Cannot Certify & Release."
  1. W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
  1. W !?27,"SUPERVISORY CERTIFICATION"
  1. S PRSTLV=3 D ^PRSAUTL G:TLI<1 EX
  1. D NOW^%DTC
  1. S DT=%\1,APDT=%,Y=$G(^PRST(458,"AD",DT)),PPI=$P(Y,U,1),DAY=$P(Y,U,2)
  1. I DAY>5,DAY<11 W $C(7),!!,MIDPP G EX
  1. I DAY<6 S X1=DT,X2=-7 D C^%DTC S PPI=$P($G(^PRST(458,"AD",X)),U,1) G:'PPI EX
  1. ; -----------------------------------------
  1. P0 ;PDT = string of pay period dates with format - Sun 29-Sep-96^
  1. ;PDTI = string of pay period dates in fileman format.
  1. ;PPI = pay period internal entry number in file 458.
  1. ;GLOB = global reference for employees pay period record
  1. ; returned from $$AVAILREC & passed to UNLOCK.
  1. ; -----------------------------------------
  1. ;
  1. S PDT=$G(^PRST(458,PPI,2)),PDTI=$G(^(1)),QT=0 K ^TMP($J)
  1. ;
  1. ; -----------------------------------------
  1. ;Loop thru this supervisor's T&L unit on x-ref in 450.
  1. ;$$availrec() ensures there's data & node with employee's
  1. ;pay period record is NOT locked, then locks node.
  1. ;Call to CHK checks for needed approvals for current employee
  1. ;If supervisor decides record is not ready, during this call,
  1. ;then node is unlocked. Records that super accepts for release
  1. ;are not unlocked until they are processed thru temp global
  1. ;& their status' are updated.
  1. ; ---------------------------------------------------
  1. ;
  1. S NN="",CKS=1
  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 I $$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G T0
  1. ;
  1. ; ---------------------------------------------------
  1. ;Loop through T&L unit file x-ref 2 c if this supervisor certifies
  1. ;payperiod data for other supervisors of other T&L units. If so
  1. ;process after ensuring node to be certified is available.
  1. ; ---------------------------------------------------
  1. ;
  1. S CKS=0
  1. F VA2=0:0 S VA2=$$TLSUP Q:VA2<1 S SSN=$$SSN I SSN'="" S DFN=$$DFN S Z=$P($G(^PRSPC(+DFN,0)),U,8) I Z'="",Z'=TLE,$$AVAILREC^PRSLIB00("SUP",.GLOB) D CHK I QT G EX:'$T,T0
  1. ;
  1. ; ---------------------------------------------------
  1. T0 I $D(^TMP($J,"E")) G T1
  1. W !!,"No records have been selected for certification."
  1. S DUMMY=$$ASK^PRSLIB00(1) G EX
  1. ;
  1. ; ---------------------------------------------------
  1. ;
  1. T1 ;if supervisor signs off then update all records in tmp
  1. ;otherwise remove any auto posting.
  1. D ^PRSAES I ESOK D
  1. .D NOW^%DTC S APDT=%
  1. .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 S VAL=$G(^(DFN)) D PROC
  1. I 'ESOK D
  1. .F DFN=0:0 S DFN=$O(^TMP($J,"E",DFN)) Q:DFN<1 D
  1. ..D AUTOPINI^PRS8(PPI,DFN)
  1. D EX
  1. Q
  1. ;
  1. ; ---------------------------------------------------
  1. CHK ; Check for needed approvals
  1. N PRSENT,PRSWOC
  1. S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),U,2) I "PX"[STAT Q
  1. I USR=DFN Q:'$D(^XUSEC("PRSA SIGN",DUZ))
  1. E I CKS S SSN=$P($G(^PRSPC(DFN,0)),U,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)),U,2)'=TLE
  1. S HDR=0 D HDR,^PRSAENT S PRSENT=ENT
  1. ;
  1. ;Loop to display tour, exceptions(leave, etc..) & errors.
  1. ;
  1. S (XF,X9)=0
  1. F DAY=1:1:14 D TOURERR($P(PDT,U,DAY),.X9,.XF) D:$Y>(IOSL-6)&(DAY<14) HDR G:QT O1
  1. ;
  1. ;Display VCS commission sales, if applicable
  1. S Z=$G(^PRST(458,PPI,"E",DFN,2))
  1. I Z'="" D:$Y>(IOSL-11) HDR Q:QT D VCS^PRSASR1
  1. ;
  1. ;
  1. S Z=$G(^PRST(458,PPI,"E",DFN,4))
  1. I Z'="" D:$Y>(IOSL-9) HDR Q:QT D ED^PRSASR1
  1. I XF W !,IORVON,"Serious error; cannot release.",IORVOFF S QT=$$ASK^PRSLIB00() Q
  1. S QT=$$ASK^PRSLIB00() Q:QT
  1. ;
  1. ;PRS8 call creates & stores 8B string in employees attendance
  1. ;record. Later, under a payroll option, string will be
  1. ;transmitted to Austin.
  1. ;
  1. N NN D ONE^PRS8 S C0=$G(^PRSPC(DFN,0)),PY=PPI D CERT^PRS8VW S QT=0
  1. ;
  1. ;Show OT (approve-vs-8B) warning & save in TMP.
  1. N WK,OTERR,O8,OA
  1. F WK=1:1:2 D
  1. . D WARNSUP^PRSAOTT(PPE,DFN,VAL,WK,.OTERR,.O8,.OA)
  1. . I OTERR S ^TMP($J,"OT",DFN,WK)=O8_U_OA
  1. ;
  1. ;warning message for rs/rn and on type of time
  1. I $E(PRSENT,5) D
  1. . I @($TR($$CD8B^PRSU1B2(VAL,"RS^3^RN^3",1),U,"+")_"-("_$TR($$RSHR^PRSU1B2(DFN,PPI),U,"+")_")") W !,?3,"WARNING: The total scheduled recess hours for this pay period does not match the total RS/RN posted."
  1. . I $G(PRSWOC)]"" W !,?3,"Warning: The entire tour for day# ",PRSWOC," is posted RECESS. The On-Call will be paid unless posted UNAVAILABLE."
  1. . QUIT
  1. ;
  1. LD ; Check for changes to the Labor Distribution Codes made during the pay
  1. ; period.
  1. I $D(^PRST(458,PPI,"E",DFN,"LDAUD")) D LD^PRSASR1
  1. ; ---------------------------------------------------
  1. OK ;Prompt Supervisor to release timecard. If yes, store in ^TMP(.
  1. ;If supervisor answers no then bypass & unlock record.
  1. ; ---------------------------------------------------
  1. W !!,IORVON,"Release to Payroll?",IORVOFF," "
  1. R X:DTIME S:'$T!(X[U) QT=1 Q:QT S:X="" X="*" S X=$TR(X,"yesno","YESNO")
  1. I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G OK
  1. I X?1"Y".E S ^TMP($J,"E",DFN)=VAL
  1. E D
  1. . D AUTOPINI^PRS8(PPI,DFN) ; remove any auto posting
  1. . D UNLOCK^PRSLIB00(GLOB) ; unlock record
  1. . K ^TMP($J,"LOCK",DFN) ;clean out of local lock list.
  1. O1 Q
  1. ;
  1. PROC ; Set Approval, file any exceptions & update 8B string
  1. ;
  1. ; get employees entitlement string in variable A1
  1. D ^PRSAENT
  1. ;
  1. ; set approvals
  1. S $P(^PRST(458,PPI,"E",DFN,0),U,3,5)=DUZ_U_APDT_U_A1
  1. ; VCS approval
  1. I $D(^PRST(458,PPI,"E",DFN,2)) S $P(^(2),U,17,18)=DUZ_U_APDT
  1. ;
  1. ; loop thru any exceptions & file in 458.5
  1. I $D(^TMP($J,"X",DFN)) S K="" F S K=$O(^TMP($J,"X",DFN,K)) Q:K="" S DAY=$P(K," ",1),X1=$P(PDTI,U,DAY),X2=$G(^(K)) D ^PRSATPF
  1. ;
  1. ; file overtime warnings
  1. F WK=1:1:2 I $G(^TMP($J,"OT",DFN,WK))'="" D
  1. . S O8=$P(^TMP($J,"OT",DFN,WK),U)
  1. . S OA=$P(^TMP($J,"OT",DFN,WK),U,2)
  1. . D FILEOTW^PRSAOTTF(PPI,DFN,WK,O8,OA)
  1. ;
  1. ;set 8b string & change status of timecard to payroll
  1. S ^PRST(458,PPI,"E",DFN,5)=VAL S $P(^PRST(458,PPI,"E",DFN,0),U,2)="P"
  1. ;set the pp telework indicator
  1. S:$P($$TWE^PRSATE0(DFN),U)]"" $P(^PRST(458,PPI,"E",DFN,0),U,8)=$P($$TWE^PRSATE0(DFN),U)
  1. ;
  1. ; If employee is a PT Phys w/ memo update hours credited
  1. D PTP^PRSASR1(DFN,PPI)
  1. ;
  1. ;unlock employees time card record
  1. S GLOB="^PRST(458,"_PPI_","_"""E"""_","_DFN_",0)"
  1. D UNLOCK^PRSLIB00(GLOB)
  1. K ^TMP($J,"LOCK",DFN) ;clean out of local lock list.
  1. Q
  1. ;
  1. ;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1. ;
  1. HDR ; Display Header
  1. I HDR S QT=$$ASK^PRSLIB00() Q:QT
  1. S X=$G(^PRSPC(DFN,0)) W !,@IOF,?2,$P(X,U,1) S X=$P(X,U,9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9) S HDR=1
  1. W !,?6,"Date",?16,"TW",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF
  1. W !?2 F I=1:1:72 W "-"
  1. Q
  1. ;====================================================================
  1. HDR2 ; Display Header don't quit
  1. N HOLD
  1. S HOLD=$$ASK^PRSLIB00(1)
  1. S X=$G(^PRSPC(DFN,0)) W !,@IOF,?2,$P(X,U,1) S X=$P(X,U,9) I X W ?68,$E(X),"XX-XX-",$E(X,6,9)
  1. W !,?6,"Date",?16,"TW",?20,"Scheduled Tour",?40,"Tour Exceptions",?63,IORVON,"Tour Errors",IORVOFF
  1. W !?2 F I=1:1:72 W "-"
  1. Q
  1. ;====================================================================
  1. ;
  1. EX ; clean up variables & unlock any leftover time card nodes
  1. N EMPREC
  1. S EMPREC=""
  1. F S EMPREC=$O(^TMP($J,"LOCK",EMPREC)) Q:EMPREC="" D
  1. . S GLOB="^PRST(458,"_PPI_","_"""E"""_","_EMPREC_",0)"
  1. . D UNLOCK^PRSLIB00(GLOB)
  1. K ^TMP($J) G KILL^XUSCLEAN
  1. Q
  1. ;
  1. ;
  1. ;These extrinsic functions simply remove lengthy code from long,
  1. ;single line, nested loop.
  1. ; ---------------------------------------------------
  1. TLSUP() ;get next supervisor who certifies other supervisors
  1. Q $O(^PRST(455.5,"ASX",TLE,VA2))
  1. ; ---------------------------------------------------
  1. SSN() ;get ssn of supervisor to be certified by this supervisor.
  1. Q $P($G(^VA(200,VA2,1)),U,9)
  1. ; ---------------------------------------------------
  1. DFN() ;get internal entry number of supvisor of other T&L 2b approved
  1. ;by current supervisor.
  1. Q $O(^PRSPC("SSN",SSN,0))
  1. ;====================================================================
  1. TOURERR(DTE,X9,XF) ;DISPLAY TOUR & ERRORS
  1. ;
  1. N IORVOFF,IORVON,RESP,ERRLEN
  1. S X="IORVOFF;IORVON" D ENDR^%ZISS
  1. D F1^PRSADP1,^PRSATPE
  1. F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) D
  1. . I $Y>(IOSL-4) D HDR2
  1. . W:K>1 !
  1. . W:$D(Y1(K)) ?21,Y1(K)
  1. . W:$P($G(Y2(K)),U)'="" ?45,$P(Y2(K),U,1)
  1. . I $P($G(Y2(K)),U,2)'="" W:$X>44 ! W ?45,$P(Y2(K),U,2)
  1. W:Y3'="" !?10,Y3
  1. I $D(ER) S:FATAL XF=1 F K=0:0 S K=$O(ER(K)) Q:K<1 D
  1. . I $Y>(IOSL-4) D HDR2
  1. . S ERRLEN=$S($P(ER(K),U,2)'="":$L(ER(K)),1:$L($P($G(ER(K)),U))+1)
  1. . W:X9!((ERRLEN+1)>(IOM-$X)) !
  1. . W ?(IOM-(ERRLEN+1)),IORVON
  1. . W:$P(ER(K),U,2)'="" $P(ER(K),U,2)
  1. . W " ",$P(ER(K),U,1),IORVOFF
  1. . S X9=0 S:'XF ^TMP($J,"X",DFN,DAY_" "_K)=ER(K)
  1. . Q
  1. Q