Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSATP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSATP.m
r613 r623 1 PRSATP ;HISC/REL,WIRMFO/MGD/PLT - Timekeeper Post Time ;11/21/06 2 ;;4.0;PAID;**22,57,69,92,102,93,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; input (from calling option) 5 ; PTPF - (optional) part-time physician flag, true (=1) when called 6 ; by the posting option for part-time physicians with a memo. 7 ; 8 N GLOB ; global reference for employee's time & attendance record. 9 N PRSDT 10 S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT 11 S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT 12 G:Y<1 EX S (PRSDT,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) 13 I PPI="" W !!,$C(7),"Pay Period is Not Open Yet!" G EX 14 S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY) 15 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 16 W !!,"Answer YES if you want all RECORDs brought up for which no data" 17 W !,"has been entered." G D2 18 ; 19 ; 20 LOOP ; 21 S LP=1,NN="" 22 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) I 'LP G EX 23 G EX 24 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 25 G:DFN<1 EX S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB) G NME 26 POST S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13) 27 I 'TC Q:LP'=2 W !!?5,"This Employee has no tour entered for this date." Q 28 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 29 S STAT=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1) 30 I LP=1,"1 3 4"[TC!(STAT'="") Q 31 ; 32 ; check if ESR is approved when posting PT Phy with memo 33 I $G(PTPF),$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,7)),U)=5 D Q:'Y!$D(DIRUT) 34 . W $C(7),! 35 . W !,"This day was auto-posted from an approved Electronic Subsidiary Record (ESR)." 36 . W !,"Normally, changes should be accomplished by having the T & L supervisor return" 37 . W !,"the ESR day to the part-time physician for correction." 38 . W !,"An exception to the above is when AWOL, On Suspension, or Non-Pay must be" 39 . W !,"posted, since those can not be entered via the ESR.",! 40 . S DIR(0)="Y" 41 . S DIR("A")="Do you want to manually post this day on the timecard" 42 . S DIR("B")="NO" 43 . D ^DIR K DIR 44 ; 45 ; lock employee record for editing by timekeeper 46 I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) S:LP=1&$G(STOP) LP=0 Q 47 D ^PRSADP1,LP,^PRSATP2,^PRSAENT 48 G P0:TC>4,P0:TC=2,P0:TC=3,P3:TC=4,P1 49 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") 50 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 51 S X=$E(X,1) I "YR"'[X G P1 52 S PTY=1 I STAT'="" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3) 53 I TC=3 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,2),"^",3)="RG",STAT="T" 54 I STAT'="",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D NOW^%DTC S NOW=%,TT="HW" D S0^PRSAPPH 55 S LV="" D A2^PRSATP0:X="R" G UPD 56 P1 R !!,"Was Employee Absent the Entire Tour? ",X:DTIME S:'$T X="^" Q:X["^" S X=$TR(X,"yesno","YESNO") 57 S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G P1 58 I X?1"Y".E D ^PRSATP0 Q:X["^" G UPD 59 I $E(ENT,1,2)["D" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10) Q 60 P3 S ZENT=$S($E(ENT,2)="H"&('$G(PTPF)):"RG ",$E(ENT,1,2)="00":"RG ",1:"") 61 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 62 I TC=3!(TC=4) D LV S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&($E(ENT,22)) ZENT=ZENT_"HW " G P31 63 D LV,OT S ZENT=ZENT_"TV TR " S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) ZENT=ZENT_"HX HW " 64 P31 S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=DFN,DA=DAY 65 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ZS 66 S DR="[PRSA TP POST1]" D ^DDS K DS Q:'$D(ZS) 67 I ZS'="" S ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS,PTY=3 G UPD 68 I $D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ^(2),^(3),^(10) 69 Q 70 UPD ; Update status 71 D NOW^%DTC 72 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_%_"^"_PTY 73 N DAH,DBH,HOL,QUIT 74 S (DAH,DBH,HOL,QUIT)="" 75 ; 76 ; Check to holiday encapsulated by a form a non-pay 77 D HENCAP^PRSATP3(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT) 78 Q:QUIT 79 D UPDT^PRSATP3(DFN,DBH,HOL,DAH) 80 K DAH,DBH,HOL,QUIT 81 Q 82 LP W !!,"Enter '^' to bypass this employee." W:LP=1 " Enter '^^' to stop T&L editing." W ! Q 83 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" 84 ; 85 ; Check to see if the employee is entitled to Military Leave and add 86 ; ML to list if they are. Added to be compliant with Public Law 87 ; 106-554. 88 S:$E(ENT,34) Z1=Z1_" 34",Z2=Z2_" ML" 89 ;9/3 month employee entitled RS with recess hours in file# 458.8 90 S:$E(ENT,5)&$P($$RSHR^PRSU1B2(DFN,PPE),U,DAY>7+1) Z1=Z1_" 5",Z2=Z2_" RS" 91 F K=1:1:$L(Z1," ") I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " 92 QUIT 93 ; 94 OT ; Get entitled out-of-tour types of time 95 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 " 96 I $E(ENT,29),'$E(ENT,26) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN " 97 ; Allow Stand By for employees w/ Prem Pay Ind = W or V 98 I $E(ENT,29),$E(ENT,26),"^W^V^"[(U_PMP_U) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN " 99 Q 100 EX ;clean up lock global which is set in $$AVAILREC^PRSLIB00 101 K ^TMP($J,"LOCK") 102 ;generic cleanup 103 G KILL^XUSCLEAN 104 ; 105 PTPSCR(PRSIEN,PSTDT,PTPF) ; part-time physician screen extrinsic function 106 ; input 107 ; PRSIEN - Employee IEN (file 450) 108 ; PSTDT - Date being posted (FileMan internal) 109 ; PTPF - (opt) Part-time physician flag, equals true (1) when screen 110 ; should only allow selection of part-time physician with 111 ; memo and false (null or 0) when screen should only 112 ; allow selection of employees that are not part-time 113 ; physicians with memo. 114 ; result 115 ; returns a boolean value (1 or 0) or null 116 ; =1 if employee passed screen 117 ; (PTPF true and employee is PTP with memo) OR 118 ; (PTPF false and employee is not PTP with memo) 119 ; =0 if employee did not pass screen 120 ; =null value if required inputs were not provided 121 ; 122 N PRSRET,PTPM 123 S PTPF=$G(PTPF) 124 S PRSRET="" ; init return 125 I PRSIEN,PSTDT D 126 . ; determine if employee is PT physician with memo on the posting date 127 . S PTPM=$S($$MIEN^PRSPUT1(PRSIEN,PSTDT)>0:1,1:0) 128 . ; apply screen 129 . S PRSRET=$S(PTPF&PTPM:1,'PTPF&'PTPM:1,1:0) 130 ; 131 Q PRSRET 132 ; 133 ;PRSATP 1 PRSATP ;HISC/REL,WIRMFO/MGD - Timekeeper Post Time ;3/21/06 2 ;;4.0;PAID;**22,57,69,92,102,93**;Sep 21, 1995;Build 7 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; input (from calling option) 5 ; PTPF - (optional) part-time physician flag, true (=1) when called 6 ; by the posting option for part-time physicians with a memo. 7 ; 8 N GLOB ; global reference for employee's time & attendance record. 9 N PRSDT 10 S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT 11 S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT 12 G:Y<1 EX S (PRSDT,D1)=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) 13 I PPI="" W !!,$C(7),"Pay Period is Not Open Yet!" G EX 14 S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY),DTI=$P($G(^(1)),"^",DAY) 15 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 16 W !!,"Answer YES if you want all RECORDs brought up for which no data" 17 W !,"has been entered." G D2 18 ; 19 ; 20 LOOP ; 21 S LP=1,NN="" 22 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) I 'LP G EX 23 G EX 24 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 25 G:DFN<1 EX S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB) G NME 26 POST S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13) 27 I 'TC Q:LP'=2 W !!?5,"This Employee has no tour entered for this date." Q 28 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 29 S STAT=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,10)),"^",1) 30 I LP=1,"1 3 4"[TC!(STAT'="") Q 31 ; 32 ; check if ESR is approved when posting PT Phy with memo 33 I $G(PTPF),$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,7)),U)=5 D Q:'Y!$D(DIRUT) 34 . W $C(7),! 35 . W !,"This day was auto-posted from an approved Electronic Subsidiary Record (ESR)." 36 . W !,"Normally, changes should be accomplished by having the T & L supervisor return" 37 . W !,"the ESR day to the part-time physician for correction." 38 . W !,"An exception to the above is when AWOL, On Suspension, or Non-Pay must be" 39 . W !,"posted, since those can not be entered via the ESR.",! 40 . S DIR(0)="Y" 41 . S DIR("A")="Do you want to manually post this day on the timecard" 42 . S DIR("B")="NO" 43 . D ^DIR K DIR 44 ; 45 ; lock employee record for editing by timekeeper 46 I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) S:LP=1&$G(STOP) LP=0 Q 47 D ^PRSADP1,LP,^PRSATP2,^PRSAENT 48 G P0:TC>4,P0:TC=2,P0:TC=3,P3:TC=4,P1 49 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") 50 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 51 S X=$E(X,1) I "YR"'[X G P1 52 S PTY=1 I STAT'="" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3) 53 I TC=3 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,2),"^",3)="RG",STAT="T" 54 I STAT'="",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) D NOW^%DTC S NOW=%,TT="HW" D S0^PRSAPPH 55 S LV="" D A2^PRSATP0:X="R" G UPD 56 P1 R !!,"Was Employee Absent the Entire Tour? ",X:DTIME S:'$T X="^" Q:X["^" S X=$TR(X,"yesno","YESNO") 57 S:X="" X="*" I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G P1 58 I X?1"Y".E D ^PRSATP0 Q:X["^" G UPD 59 I $E(ENT,1,2)["D" K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10) Q 60 P3 S ZENT=$S($E(ENT,2)="H"&('$G(PTPF)):"RG ",$E(ENT,1,2)="00":"RG ",1:"") 61 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 62 I TC=3!(TC=4) D LV S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)&($E(ENT,22)) ZENT=ZENT_"HW " G P31 63 D LV,OT S ZENT=ZENT_"TV TR " S:$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) ZENT=ZENT_"HX HW " 64 P31 S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=DFN,DA=DAY 65 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ZS 66 S DR="[PRSA TP POST1]" D ^DDS K DS Q:'$D(ZS) 67 I ZS'="" S ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS,PTY=3 G UPD 68 I $D(^PRST(458,PPI,"E",DFN,"D",DAY,2)) K ^(2),^(3),^(10) 69 Q 70 UPD ; Update status 71 D NOW^%DTC 72 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_%_"^"_PTY 73 N DAH,DBH,HOL,QUIT 74 S (DAH,DBH,HOL,QUIT)="" 75 ; 76 ; Check to holiday encapsulated by a form a non-pay 77 D HENCAP^PRSATP3(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT) 78 Q:QUIT 79 D UPDT^PRSATP3(DFN,DBH,HOL,DAH) 80 K DAH,DBH,HOL,QUIT 81 Q 82 LP W !!,"Enter '^' to bypass this employee." W:LP=1 " Enter '^^' to stop T&L editing." W ! Q 83 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" 84 ; 85 ; Check to see if the employee is entitled to Military Leave and add 86 ; ML to list if they are. Added to be compliant with Public Law 87 ; 106-554. 88 ; 89 I $E(ENT,34) D 90 . S Z1=Z1_" 34",Z2=Z2_" ML" 91 . F K=1:1:14 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " 92 ; 93 I '$E(ENT,34) D 94 . F K=1:1:13 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" " 95 Q 96 OT ; Get entitled out-of-tour types of time 97 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 " 98 I $E(ENT,29),'$E(ENT,26) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN " 99 ; Allow Stand By for employees w/ Prem Pay Ind = W or V 100 I $E(ENT,29),$E(ENT,26),"^W^V^"[(U_PMP_U) S ZENT=ZENT_"SB " S:ZENT'["UN" ZENT=ZENT_"UN " 101 Q 102 EX ;clean up lock global which is set in $$AVAILREC^PRSLIB00 103 K ^TMP($J,"LOCK") 104 ;generic cleanup 105 G KILL^XUSCLEAN 106 ; 107 PTPSCR(PRSIEN,PSTDT,PTPF) ; part-time physician screen extrinsic function 108 ; input 109 ; PRSIEN - Employee IEN (file 450) 110 ; PSTDT - Date being posted (FileMan internal) 111 ; PTPF - (opt) Part-time physician flag, equals true (1) when screen 112 ; should only allow selection of part-time physician with 113 ; memo and false (null or 0) when screen should only 114 ; allow selection of employees that are not part-time 115 ; physicians with memo. 116 ; result 117 ; returns a boolean value (1 or 0) or null 118 ; =1 if employee passed screen 119 ; (PTPF true and employee is PTP with memo) OR 120 ; (PTPF false and employee is not PTP with memo) 121 ; =0 if employee did not pass screen 122 ; =null value if required inputs were not provided 123 ; 124 N PRSRET,PTPM 125 S PTPF=$G(PTPF) 126 S PRSRET="" ; init return 127 I PRSIEN,PSTDT D 128 . ; determine if employee is PT physician with memo on the posting date 129 . S PTPM=$S($$MIEN^PRSPUT1(PRSIEN,PSTDT)>0:1,1:0) 130 . ; apply screen 131 . S PRSRET=$S(PTPF&PTPM:1,'PTPF&'PTPM:1,1:0) 132 ; 133 Q PRSRET 134 ; 135 ;PRSATP
Note:
See TracChangeset
for help on using the changeset viewer.
