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

PRSATP.m

Go to the documentation of this file.
  1. PRSATP ;HISC/REL,WIRMFO/MGD/PLT - Timekeeper Post Time ;4/13/2012
  1. ;;4.0;PAID;**22,57,69,92,102,93,112,126,132,137**;Sep 21, 1995;Build 4
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ; input (from calling option)
  1. ; PTPF - (optional) part-time physician flag, true (=1) when called
  1. ; by the posting option for part-time physicians with a memo.
  1. ;
  1. N GLOB ; global reference for employee's time & attendance record.
  1. N PRSDT
  1. S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT
  1. S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT
  1. G:Y<1 EX S (PRSDT,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
  1. I PPI="" W !!,$C(7),"Pay Period is Not Open Yet!" G EX
  1. S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY)
  1. D2 W !!,"Would you like to edit the T & A RECORDs in alphabetical order" S %=1 D YN^DICN I % S LP=% G EX:%=-1,LOOP:%=1,NME
  1. W !!,"Answer YES if you want all RECORDs brought up for which no data"
  1. W !,"has been entered." G D2
  1. ;
  1. ;
  1. LOOP ;
  1. S LP=1,NN=""
  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 $$PTPSCR(DFN,PRSDT,$G(PTPF)) S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB),NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT) I 'LP G EX
  1. G EX
  1. NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y)),$$PTPSCR^PRSATP(+Y,PRSDT,$G(PTPF))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
  1. G:DFN<1 EX S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB),NURSEPOC^PRSNEETP(TLI,PPI,DFN,PRSDT) G NME
  1. POST S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13)
  1. I 'TC Q:LP'=2 W !!?5,"This Employee has no tour entered for this date." Q
  1. I "T"'[$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) W:LP=2 $C(7),!!,"This Employee has already been sent to Payroll." Q
  1. S STAT=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1)
  1. I LP=1,"1 3 4"[TC!(STAT'="") Q
  1. ;
  1. ; check if ESR is approved when posting PT Phy with memo
  1. I $G(PTPF),$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,7)),U)=5 D Q:'Y!$D(DIRUT)
  1. . W $C(7),!
  1. . W !,"This day was auto-posted from an approved Electronic Subsidiary Record (ESR)."
  1. . W !,"Normally, changes should be accomplished by having the T & L supervisor return"
  1. . W !,"the ESR day to the part-time physician for correction."
  1. . W !,"An exception to the above is when AWOL, On Suspension, or Non-Pay must be"
  1. . W !,"posted, since those can not be entered via the ESR.",!
  1. . S DIR(0)="Y"
  1. . S DIR("A")="Do you want to manually post this day on the timecard"
  1. . S DIR("B")="NO"
  1. . D ^DIR K DIR
  1. ;
  1. ; lock employee record for editing by timekeeper
  1. I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) S:LP=1&$G(STOP) LP=0 Q
  1. D ^PRSADP1,LP,^PRSATP2,^PRSAENT
  1. G P0:TC>4,P0:TC=2,P0:TC=3,P3:TC=4,P1
  1. P0 R !!,"Did Employee Only Work Scheduled Tour? ",X:DTIME S:'$T X="^^" S:X["^^" LP=0 Q:X["^" S X=$TR(X,"yesnor","YESNOR")
  1. S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="",X'="R" W $C(7),!?5," Answer YES or NO or R for Normal Posting with Remarks" G P0
  1. S X=$E(X,1) I "YR"'[X G P1
  1. S PTY=1 I STAT'="" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3)
  1. I TC=3 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,2),"^",3)="RG",STAT="T"
  1. I STAT'="",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D NOW^%DTC S NOW=%,TT="HW" D S0^PRSAPPH
  1. S LV="" D A2^PRSATP0:X="R" G UPD
  1. P1 R !!,"Was Employee Absent the Entire Tour? ",X:DTIME S:'$T X="^" Q:X["^" S X=$TR(X,"yesno","YESNO")
  1. S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G P1
  1. I X?1"Y".E D ^PRSATP0 Q:X["^" G UPD
  1. ;
  1. ;for daily employees if you say they didn't work and they were not absent
  1. ;then effectively you have not created any posting for the day and we
  1. ;clean up any prior posting
  1. I $E(ENT,1,2)["D" D Q
  1. . K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10)
  1. . D CLEANTW^PRSATPTW(PPI,DFN,DAY)
  1. ;
  1. P3 S ZENT=$S($E(ENT,2)="H"&('$G(PTPF)):"RG ",$E(ENT,1,2)="00":"RG ",1:"")
  1. I TC=1 D OT S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&(AC="M2E") ZENT=ZENT_"HW " S ZENT=ZENT_"NP CP " G P31
  1. I TC=3!(TC=4) D LV,OT S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&($E(ENT,22)) ZENT=ZENT_"HW " G P31 ;PRS*137
  1. D LV,OT S ZENT=ZENT_"TV TR " S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) ZENT=ZENT_"HX HW "
  1. P31 S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=DFN,DA=DAY
  1. S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ZS
  1. S DR="[PRSA TP POST1]" D ^DDS K DS
  1. ; timekeeper has indicated there are exceptions, if they don't enter any, quit.
  1. I '$D(ZS) QUIT:'$D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) S PTY=3 G UPD
  1. I ZS'="" S ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS,PTY=3 G UPD
  1. ; if employee had exceptions, but timekeeper deletes them, then clear posting
  1. ; data because prompts that the employee was not absent and did not work
  1. ; entire tour were answered such that there must be exceptions
  1. I $D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) D
  1. . K ^(2),^(3),^(10)
  1. . D CLEANTW^PRSATPTW(PPI,DFN,DAY)
  1. Q
  1. UPD ; Update status
  1. D TELEWORK^PRSATPTW(PPI,DFN,DAY,STAT,PTY,TC)
  1. D NOW^%DTC
  1. S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_%_"^"_PTY
  1. N DAH,DBH,HOL,QUIT
  1. S (DAH,DBH,HOL,QUIT)=""
  1. ;
  1. ; Check to holiday encapsulated by a form a non-pay
  1. D HENCAP^PRSATP3(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
  1. Q:QUIT
  1. D UPDT^PRSATP3(DFN,DBH,HOL,DAH)
  1. K DAH,DBH,HOL,QUIT
  1. Q
  1. LP W !!,"Enter '^' to bypass this employee." W:LP=1 " Enter '^^' to stop T&L editing." W ! Q
  1. LV S Z1="30 31 31 31 32 33 28 35 35 30 36 37 38",Z2="AL SL CB AD NL WP CU AA DL RL NP CP HX"
  1. ;
  1. ; Check to see if the employee is entitled to Military Leave and add
  1. ; ML to list if they are. Added to be compliant with Public Law
  1. ; 106-554.
  1. S:$E(ENT,34) Z1=Z1_" 34",Z2=Z2_" ML"
  1. ;9/3 month employee entitled RS with recess hours in file# 458.8
  1. S:$E(ENT,5)&$P($$RSHR^PRSU1B2(DFN,PPE),U,DAY>7+1) Z1=Z1_" 5",Z2=Z2_" RS"
  1. F K=1:1:$L(Z1," ") I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" "
  1. QUIT
  1. ;
  1. OT ; Get entitled out-of-tour types of time
  1. S Z1="12 28 26",Z2="OT CT ON" F K=1:1:3 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " I ZENT'["UN" S ZENT=ZENT_"UN "
  1. I $E(ENT,29),'$E(ENT,26) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN "
  1. ; Allow Stand By for employees w/ Prem Pay Ind = W or V
  1. I $E(ENT,29),$E(ENT,26),"^W^V^"[(U_PMP_U) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN "
  1. Q
  1. EX ;clean up lock global which is set in $$AVAILREC^PRSLIB00
  1. K ^TMP($J,"LOCK")
  1. ;generic cleanup
  1. G KILL^XUSCLEAN
  1. ;
  1. PTPSCR(PRSIEN,PSTDT,PTPF) ; part-time physician screen extrinsic function
  1. ; input
  1. ; PRSIEN - Employee IEN (file 450)
  1. ; PSTDT - Date being posted (FileMan internal)
  1. ; PTPF - (opt) Part-time physician flag, equals true (1) when screen
  1. ; should only allow selection of part-time physician with
  1. ; memo and false (null or 0) when screen should only
  1. ; allow selection of employees that are not part-time
  1. ; physicians with memo.
  1. ; result
  1. ; returns a boolean value (1 or 0) or null
  1. ; =1 if employee passed screen
  1. ; (PTPF true and employee is PTP with memo) OR
  1. ; (PTPF false and employee is not PTP with memo)
  1. ; =0 if employee did not pass screen
  1. ; =null value if required inputs were not provided
  1. ;
  1. N PRSRET,PTPM
  1. S PTPF=$G(PTPF)
  1. S PRSRET="" ; init return
  1. I PRSIEN,PSTDT D
  1. . ; determine if employee is PT physician with memo on the posting date
  1. . S PTPM=$S($$MIEN^PRSPUT1(PRSIEN,PSTDT)>0:1,1:0)
  1. . ; apply screen
  1. . S PRSRET=$S(PTPF&PTPM:1,'PTPF&'PTPM:1,1:0)
  1. ;
  1. Q PRSRET
  1. ;
  1. ;PRSATP