Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSALVS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSALVS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSALVS.m
r613 r623 1 PRSALVS ;HISC/REL-Display Leave Request ;11/21/06 2 ;;4.0;PAID;**9,69,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) 5 I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX 6 D HDR 7 K %DT S %DT="AEX",%DT("A")="Begin with Date: ",%DT("B")="T" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=9999999-Y 8 W ! S NUM=0 D DISP,H1 G EX 9 DISP ; Display Leave Requests 10 S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3),CNT=0,QT=0 K:NUM R 11 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>EDT) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" D LST G:QT D0 12 W:'CNT !,"No Requests on File." 13 D0 Q 14 LST ; Display Request 15 S Z=$G(^PRST(458.1,DA,0)) Q:Z="" Q:$P(Z,"^",9)="X" S SCOM=$P($G(^(1)),"^",1) I NUM,$P(Z,"^",9)'="R" Q:"D"[$P(Z,"^",9) D Q:Z="" 16 .S X=$P(Z,"^",3),X=$G(^PRST(458,"AD",+X)) 17 .S Y=$G(^PRST(458,+$P(X,"^",1),"E",DFN,"D",+$P(X,"^",2),2)) 18 .Q:Y'[$P(Z,"^",7) S Z="" Q 19 I CNT D:$Y>(IOSL-4) H1 Q:QT 20 S CNT=CNT+1 W ! I NUM W $J(CNT,2)," " S R(CNT)=DA 21 W $P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," to ",$P(Z,"^",6)," " 22 S X=$P(Z,"^",5) D DTP^PRSAPPU W Y," " 23 S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," " 24 S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," " 25 S X=$P(Z,"^",9) 26 S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1) 27 S X=$P(Z,"^",8) W:X'="" !?5,X S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y 28 W:SCOM'="" !?5,"Supr: ",SCOM Q 29 BAL ; Leave Balance 30 N CNT,PPE S Z=$P($G(^PRST(458.1,DA,0)),"^",7),(BAL,INC,CNT)="" Q:Z="" 31 I "CB AD"[Z N Z S Z="SL" 32 Q:"AL SL CU ML RL"'[Z D ^PRSALVT I NH'=48!(DB'=1) G B0 33 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",1) G B2 34 I Z="SL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",13) G B2 35 I Z="RL" S BAL=$G(^PRSPC(DFN,"BAYLOR")),BAL=$P(BAL,"^",9)+$P(BAL,"^",10) G B2 36 G B1 37 B0 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"ANNUAL")),"^",3) G B2 38 I Z="SL" S BAL=$P($G(^PRSPC(DFN,"SICK")),"^",3) G B2 39 I Z="RL" S BAL=$G(^PRSPC(DFN,"ANNUAL")),BAL=$P(BAL,"^",10)+$P(BAL,"^",11) G B2 40 B1 I Z="ML" S BAL=$P($G(^PRSPC(DFN,"MILITARY")),"^",1) G B2 41 Q:Z'="CU" S Z="CT",Y=$G(^PRSPC(DFN,"COMP")) 42 F K=1:1:8 S BAL=BAL+$P(Y,"^",K) 43 B2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16),D1=DT D PP^PRSAPPU S YR=$P(PPE,"-",1) 44 S D1=+$P(PPE,"-",2),YR=$S(D1'<LST:YR,1:$E(199+YR,2,3)),PPE=YR_"-"_$S(LST>9:LST,1:"0"_LST) 45 S PPI=$O(^PRST(458,"B",PPE,0)),SDT=DT I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14),SDT=$P($G(^(1)),"^",14) 46 I PRT W !,Z," Leave Balance: ",$S(Z="ML":$J(BAL,13,2),1:$J(BAL,13,3))," as of ",D1 47 I "AL SL"'[Z Q 48 S EDT=$P($G(^PRST(458.1,DA,0)),"^",5) I EDT'>SDT G B3 49 S X1=EDT,X2=SDT D ^%DTC S INC=X+13\14*$S(Z="AL":AINC,1:SINC) 50 I NH=80,DB=2 S X1=EDT,X2=X+13\14*14-X D C^%DTC S INC=INC-$$RT(X,SDT) S:INC<0 INC=0 51 I PRT W !,Z," Estimated Earnings: ",$J(INC,8,3) 52 S LST=9999999-SDT,CNT=0 53 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F RDA=0:0 S RDA=$O(^PRST(458.1,"AD",DFN,DTI,RDA)) Q:RDA="" I $G(^(RDA))'>EDT D 54 .S Z1=$G(^PRST(458.1,RDA,0)) S X1=$P(Z1,"^",7) S:"CB AD"[X1 X1="SL" Q:X1'=Z Q:"AR"'[$P(Z1,"^",9) 55 .I NH=72,DB=1 S $P(Z1,U,15)=$$LC($P(Z1,U,15)) 56 .S CNT=CNT+$P(Z1,"^",15) 57 .I $P(Z1,"^",3)'<SDT,$P(Z1,"^",5)'>EDT Q 58 .S X1=$P(Z1,"^",5),X2=$P(Z1,"^",3) D ^%DTC S Z3=$P(Z1,"^",15)/$S($G(X):X,1:1) 59 .I $P(Z1,"^",3)<SDT S X1=SDT,X2=$P(Z1,"^",3) D ^%DTC I X>0 S CNT=CNT-(X*Z3) 60 .I $P(Z1,"^",5)>EDT S X1=$P(Z1,"^",5),X2=EDT D ^%DTC I X>0 S CNT=CNT-(X*Z3) 61 .Q 62 I PRT W !,Z," Estimated Usage: ",$J(CNT,11,3) 63 B3 S BAL=BAL+INC-CNT I PRT W !,Z," Projected Balance: ",$J(BAL,9,3) 64 I PRT,BAL<0 W !,"Warning: Approval MAY result in a negative leave balance." 65 Q 66 HDR ; Display Header 67 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS" 68 S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50,"XXX-XX-",$E(X,6,9) Q 69 H1 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 I 'QT W @IOF,! 70 Q 71 EX G KILL^XUSCLEAN 72 ;Multiply leave request by 1.111 and round down to the quarter hour 73 ;for 36/40 nurses 74 LC(X) S X=X*1.111\.25*.25 Q X 75 ;Calculate number of Recess hours scheduled for a 9-month AWS Nurse 76 ;before the date leave has been requested for 77 RT(EDT,SDT) N SFY,EFY,T,WK 78 S SFY=$E($P($$GETFSCYR^PRSARC04(SDT),U,2),3,6),EFY=$E($P($$GETFSCYR^PRSARC04(EDT),U,2),3,6) 79 D RES^PRSARC05(.WK,DFN,SFY,EFY,SDT,EDT) S (I,T)=0 F S I=$O(WK(I)) Q:I="" S T=T+WK(I) 80 ;Calculate the number of hours of leave that would have been 81 ;accumulated for the time the nurse was on recess. 82 Q T/80*$S(Z="AL":AINC,1:SINC)\.25*.25 1 PRSALVS ;HISC/REL-Display Leave Request ;09/21/01 2 ;;4.0;PAID;**9,69**;Sep 21, 1995 3 S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) 4 I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX 5 D HDR 6 K %DT S %DT="AEX",%DT("A")="Begin with Date: ",%DT("B")="T" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=9999999-Y 7 W ! S NUM=0 D DISP,H1 G EX 8 DISP ; Display Leave Requests 9 S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3),CNT=0,QT=0 K:NUM R 10 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>EDT) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" D LST G:QT D0 11 W:'CNT !,"No Requests on File." 12 D0 Q 13 LST ; Display Request 14 S Z=$G(^PRST(458.1,DA,0)) Q:Z="" Q:$P(Z,"^",9)="X" S SCOM=$P($G(^(1)),"^",1) I NUM,$P(Z,"^",9)'="R" Q:"D"[$P(Z,"^",9) D Q:Z="" 15 .S X=$P(Z,"^",3),X=$G(^PRST(458,"AD",+X)) 16 .S Y=$G(^PRST(458,+$P(X,"^",1),"E",DFN,"D",+$P(X,"^",2),2)) 17 .Q:Y'[$P(Z,"^",7) S Z="" Q 18 I CNT D:$Y>(IOSL-4) H1 Q:QT 19 S CNT=CNT+1 W ! I NUM W $J(CNT,2)," " S R(CNT)=DA 20 W $P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," to ",$P(Z,"^",6)," " 21 S X=$P(Z,"^",5) D DTP^PRSAPPU W Y," " 22 S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," " 23 S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," " 24 S X=$P(Z,"^",9) 25 S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1) 26 S X=$P(Z,"^",8) W:X'="" !?5,X S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y 27 W:SCOM'="" !?5,"Supr: ",SCOM Q 28 BAL ; Leave Balance 29 N CNT,PPE S Z=$P($G(^PRST(458.1,DA,0)),"^",7),(BAL,INC,CNT)="" Q:Z="" 30 I "CB AD"[Z N Z S Z="SL" 31 Q:"AL SL CU ML RL"'[Z D ^PRSALVT I NH'=48!(DB'=1) G B0 32 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",1) G B2 33 I Z="SL" S BAL=$P($G(^PRSPC(DFN,"BAYLOR")),"^",13) G B2 34 I Z="RL" S BAL=$G(^PRSPC(DFN,"BAYLOR")),BAL=$P(BAL,"^",9)+$P(BAL,"^",10) G B2 35 G B1 36 B0 I Z="AL" S BAL=$P($G(^PRSPC(DFN,"ANNUAL")),"^",3) G B2 37 I Z="SL" S BAL=$P($G(^PRSPC(DFN,"SICK")),"^",3) G B2 38 I Z="RL" S BAL=$G(^PRSPC(DFN,"ANNUAL")),BAL=$P(BAL,"^",10)+$P(BAL,"^",11) G B2 39 B1 I Z="ML" S BAL=$P($G(^PRSPC(DFN,"MILITARY")),"^",1) G B2 40 Q:Z'="CU" S Z="CT",Y=$G(^PRSPC(DFN,"COMP")) 41 F K=1:1:8 S BAL=BAL+$P(Y,"^",K) 42 B2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16),D1=DT D PP^PRSAPPU S YR=$P(PPE,"-",1) 43 S D1=+$P(PPE,"-",2),YR=$S(D1'<LST:YR,1:$E(199+YR,2,3)),PPE=YR_"-"_$S(LST>9:LST,1:"0"_LST) 44 S PPI=$O(^PRST(458,"B",PPE,0)),SDT=DT I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14),SDT=$P($G(^(1)),"^",14) 45 I PRT W !,Z," Leave Balance: ",$S(Z="ML":$J(BAL,13,2),1:$J(BAL,13,3))," as of ",D1 46 I "AL SL"'[Z Q 47 S EDT=$P($G(^PRST(458.1,DA,0)),"^",5) I EDT'>SDT G B3 48 S X1=EDT,X2=SDT D ^%DTC S INC=X+13\14*$S(Z="AL":AINC,1:SINC) 49 I PRT W !,Z," Estimated Earnings: ",$J(INC,8,3) 50 S LST=9999999-SDT,CNT=0 51 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F RDA=0:0 S RDA=$O(^PRST(458.1,"AD",DFN,DTI,RDA)) Q:RDA="" I $G(^(RDA))'>EDT D 52 .S Z1=$G(^PRST(458.1,RDA,0)) S X1=$P(Z1,"^",7) S:"CB AD"[X1 X1="SL" Q:X1'=Z Q:"AR"'[$P(Z1,"^",9) 53 .S CNT=CNT+$P(Z1,"^",15) 54 .I $P(Z1,"^",3)'<SDT,$P(Z1,"^",5)'>EDT Q 55 .S X1=$P(Z1,"^",5),X2=$P(Z1,"^",3) D ^%DTC S Z3=$P(Z1,"^",15)/$S($G(X):X,1:1) 56 .I $P(Z1,"^",3)<SDT S X1=SDT,X2=$P(Z1,"^",3) D ^%DTC I X>0 S CNT=CNT-(X*Z3) 57 .I $P(Z1,"^",5)>EDT S X1=$P(Z1,"^",5),X2=EDT D ^%DTC I X>0 S CNT=CNT-(X*Z3) 58 .Q 59 I PRT W !,Z," Estimated Usage: ",$J(CNT,11,3) 60 B3 S BAL=BAL+INC-CNT I PRT W !,Z," Projected Balance: ",$J(BAL,9,3) 61 I PRT,BAL<0 W !,"Warning: Approval MAY result in a negative leave balance." 62 Q 63 HDR ; Display Header 64 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?32,"LEAVE REQUESTS" 65 S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) Q 66 H1 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 I 'QT W @IOF,! 67 Q 68 EX G KILL^XUSCLEAN
Note:
See TracChangeset
for help on using the changeset viewer.
