Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/PAID-PRS/PRS8EX.m

    r613 r623  
    1 PRS8EX  ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;1/31/2007
    2         ;;4.0;PAID;**2,40,56,69,111,112**;Sep 21, 1995;Build 54
    3         ;;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5         ;This routine is used to process most exceptions to the normal
    6         ;tod.  It is used, for example, to determine whether or not the
    7         ;employee is entitled to such exceptions as Leave, OT, etc.,
    8         ;and then calls ^PRS8AC to process them.
    9         ;
    10         ;Called by Routines:  PRS8ST
    11         ;
    12         S TT=$P(V,"^",3) ;type of time
    13         I TT="OT",+$P(V,"^",4)=8,$E(ENT,18) S TT="TT" ;ot in travel status
    14         I TT="CU",$P(V,"^",4)=6 Q  ;comp for religious purposes/don't code
    15         I TT="HW",$E(ENT,1,2)="0D" S TT="RG"
    16         I TT="OT",TYP["P",TYP'["B" S TT="RG" ;To convert Pt ot to RG
    17         I TT="HW",TYP'["D",+V,+$P(V,"^",2) D
    18         .I $P(V,"^",2)-V-1<8 D  ; <2 hrs HW
    19         ..S ^TMP($J,"PRS8",DY,"HW")=$G(^TMP($J,"PRS8",DY,"HW"))_$P(V,U,1,2)_U
    20         ..Q
    21         .I TYP["P",$P(V,"^",2)>96 S LEN=$P(V,"^",2)-96 D  ;two day tour of HW for part timers
    22         ..S ^TMP($J,"PRS8",DY+1,"HWK")=$G(^TMP($J,"PRS8",DY+1,"HWK"))_1_U_LEN_U
    23         ..K LEN
    24         ..Q
    25         .I TYP["P",TYP["N"!(TYP["H"),'$E(DAY(DY,"W"),+V) D  ; part time nurses, uscheduled HW.
    26         ..S ^TMP($J,"PRS8",DY,"HWK")=$G(^TMP($J,"PRS8",DY,"HWK"))_$P(V,U,1,2)_U
    27         ..Q
    28         .Q
    29         S X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL^RS" ;code
    30         S X=($F(X,"^"_TT)\3)+4,(X,TT(1))=$P($T(ACT+X),";;",2) ;parameters
    31         S GO=0 I '+X!($E(ENT,+X)) S GO=1 ;entitlement exists-continue
    32         I TT="RG",$E(ENT,2)'=0 S GO=1 ;intermittent
    33         I TT="RG"!(TT="CP"),$E(ENT,2)="D" S DAY(DY,"DWK")=1 ;intrmtnt-count days worked (for RG or CP)
    34         I TT="OT",'GO,$E(ENT,13)!$E(ENT,14) S GO=1 ;entitled to ot
    35         I TT="UN" S GO=1,VAR="-" ;unavailable
    36         I TYP["W",TT="RG",$P(V,"^",4)=7 D
    37         .;wage grade employee working regular unscheduled hours for
    38         .;shift coverage (7) can get shift differential based on the higher
    39         .;of the unscheduled tour's shift or their normal shift.
    40         .;The unscheduled tour and corresponding differential will be saved
    41         .;in the "SD" node and used by PRS8PP when differentials are
    42         .;computed.
    43         .N ST,EN,SD,MID
    44         .S ST=$P(V,"^"),EN=$P(V,"^",2) Q:'ST!'EN
    45         .S MID=ST+EN/2
    46         .; check for 2day tour and if found use combined tour (recompute MID)
    47         .; to determine appropriate shift differential.
    48         .; if start is 1 (midnight) then check previous day for a similar tour
    49         .; that ended at 96 (midnight).
    50         . I ST=1 D
    51         .. N PRSI,PRSX
    52         .. S PRSX=$G(^TMP($J,"PRS8",DY-1,2))
    53         .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)=""  D
    54         ... I $P(PRSX,U,(PRSI-1)*4+2)=96,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=($P(PRSX,U,(PRSI-1)*4+1)+EN+96)/2
    55         .; if end is 96 (midnight) then check next day for a similar tour that
    56         .; starts at 1 (midnight).
    57         . I EN=96 D
    58         .. N PRSI,PRSX
    59         .. S PRSX=$G(^TMP($J,"PRS8",DY+1,2))
    60         .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)=""  D
    61         ... I $P(PRSX,U,(PRSI-1)*4+1)=1,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=(ST+$P(PRSX,U,(PRSI-1)*4+2)+96)/2
    62         .; determine shift differential (if any) based on unscheduled tour hours
    63         .S SD=0
    64         .I MID<32.5 S SD=3 ; majority of tour before 8a
    65         .I MID>60.5,MID'>94.5 S SD=2 ; majority of tour after 3p, upto 11:30p
    66         .I MID>94.5,MID<128.5 S SD=3 ; majority of tour after 11:30p, before 8a
    67         .; use employee's normal shift if higher than shift based on hours
    68         .I TOUR>1,TOUR>SD S SD=TOUR
    69         .S:SD ^TMP($J,"PRS8",DY,"SD")=$G(^TMP($J,"PRS8",DY,"SD"))_ST_U_EN_U_SD_U
    70         .Q
    71         I (TT="OT"!(TT="RG")!(TT="CT")),"^13^14^"[("^"_$P(V,"^",4)_"^")!($P(V,"^",4)=12&(TYP["N"!(TYP["H"))) D
    72         .S ^TMP($J,"PRS8",DY,"CB")=$G(^TMP($J,"PRS8",DY,"CB"))_$P(V,"^",1,2)_"^"
    73         .Q
    74         I TYP'["D",TT="HX"!(TT="HW") S GO=1 ;process holiday excused/worked
    75         G END:'GO ;nothing to process
    76         I TT'="UN" S VAR=$P(X,"^",3) ;increment time code
    77         I '$S(VAR'="W":1,'CYA:1,DY<CYA:1,1:0) D
    78         .S WPCY=1 ;flag to save WOP in hours from 1/1 for calendar year adjustment
    79         I TYP'["D" D  G END ;process hourly people and quit
    80         .; The following 2 lines commented out because for Employees that are
    81         .; non-daily tour (TYP'["D"), policy is has been described that all
    82         .; ML/COP has to be posted by time-keeper.
    83         .; If this changes, then uncomment these lines, remove the line adding
    84         .; military leave and COP that follows, and refer to routine PRS8UP.
    85         .; I VAR="M" S ^TMP($J,"PRS8",DY,"ML")=1,MILV=1 ;military leave taken
    86         .; I VAR="V" S ^TMP($J,"PRS8",DY,"CP")=1,WCMP=1 ;cont of pay indicator
    87         .I DY>0,DY<15 D
    88         ..; Post ML for employees who are charged in days.
    89         ..I VAR="M",$$MLINHRS^PRSAENT(DFN)=0 D
    90         ...S X=$P(TT(1),"^",4) D SET ; military leave & auth. absence
    91         ..I VAR="V",'$G(^TMP($J,"PRS8",DY,"CP")) S X="M",^TMP($J,"PRS8",DY,"CP")=1 D SET ; COP
    92         ..Q
    93         .D ^PRS8AC ;update activity string
    94         .Q
    95         ; Employees with daily tours (TYP["D")
    96         I DY>0,DY<15,VAR="M" S X=$P(TT(1),"^",4) D SET S X=5 D SET G END ;military leave & auth. absence
    97         I DY>0,DY<15,$$HOLIDAY^PRS8UT(PY,DFN,DY) D  G END ;holiday-no charge
    98         .I TT="RG" S DAY(DY,"W")=VAR,X=$S('$E(ENT,TOUR+21):9,1:TOUR+28) D SET ; If worked on holiday count it.
    99         .Q
    100         S D=DY
    101         I TT="NP"!($P(DAY(D,0),"^",2)'=1) S DAY(D,"W")=VAR,X=$P(TT(1),"^",4) I X'="",DY>0,DY<15 D SET I VAR="V" S X="M" D SET I VAR="V",TYP["DI",$E(ENT,2)="D" S X=9 D SET ; IF INT RESDNT PAID IN DAYS HAS COP POSTED PAY UN/US ALSO
    102         D ENCAP^PRS8EX0
    103         ;
    104 END     ; --- all done here     
    105         K A,D,DD,GO,TT,X,Z
    106         Q
    107         ;
    108 SET     ; --- enter here to set without VAL defined
    109         ; Quit if this day has already been counted through the encapsulation
    110         ; check that is performed in ENCAP^PRS8EX0.
    111         Q:$D(^TMP($J,"PRS8",DY,2,0))
    112         ;
    113         Q:X="K"&($P(V,"^",1)>96)!((X="K")&($D(^TMP($J,"PRS8",DY,"ML"))))  S ^TMP($J,"PRS8",DY,"ML")=1 ;stop counting ML twice for two day tours & split tours, but allow PC
    114         I +X S $P(WK(WK),"^",+X)=$P(WK(WK),"^",+X)+1
    115         E  S X=$A(X)-64,$P(WK(3),"^",+X)=$P(WK(3),"^",+X)+1
    116         Q
    117         ;
    118 ACT     ; --- define variable X for action
    119         ;     - piece 1 = entitlement (ENT) string $Extract to check
    120         ;     -       2 = Literal name of exception
    121         ;     -       3 = Time String code (DAY(X,"W"))
    122         ;;
    123         ;;30^Annual Leave^L^1
    124         ;;31^Sick Leave^S^2
    125         ;;33^Without Pay^W^3
    126         ;;36^Non-Pay Status^n^4
    127         ;;35^Authorized Absence^A^5
    128         ;;30^Restored Leave^R^6
    129         ;;28^Comp Used^U^8
    130         ;;28^Comp Earned^E^7
    131         ;;37^Continuation of Pay^V^33
    132         ;;38^Holiday Excused^H
    133         ;;34^Military Leave^M^K
    134         ;;0^Training^X^43
    135         ;;0^Travel^Y^42
    136         ;;12^Overtime^O
    137         ;;2^Unscheduled^4^9
    138         ;;18^OT in Travel Status^T
    139         ;;29^Standby^B
    140         ;;26^On-Call^C
    141         ;;36^Nonpay A/L^N^A
    142         ;;38^Holiday Worked^h
    143         ;;31^Care and Bereavement^F^44
    144         ;;31^Adoption^G^45
    145         ;;35^Donor Leave^D^46
    146         ;;5^Recess^r^48
     1PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;1/25/2007
     2 ;;4.0;PAID;**2,40,56,69,111**;Sep 21, 1995;Build 2
     3 ;;Per VHA Directive 2004-038, this routine should not be modified.
     4 ;
     5 ;This routine is used to process most exceptions to the normal
     6 ;tod.  It is used, for example, to determine whether or not the
     7 ;employee is entitled to such exceptions as Leave, OT, etc.,
     8 ;and then calls ^PRS8AC to process them.
     9 ;
     10 ;Called by Routines:  PRS8ST
     11 ;
     12 S TT=$P(V,"^",3) ;type of time
     13 I TT="OT",+$P(V,"^",4)=8,$E(ENT,18) S TT="TT" ;ot in travel status
     14 I TT="CU",$P(V,"^",4)=6 Q  ;comp for religious purposes/don't code
     15 I TT="HW",$E(ENT,1,2)="0D" S TT="RG"
     16 I TT="OT",TYP["P",TYP'["B" S TT="RG" ;To convert Pt ot to RG
     17 I TT="HW",TYP'["D",+V,+$P(V,"^",2) D
     18 .I $P(V,"^",2)-V-1<8 D  ; <2 hrs HW
     19 ..S ^TMP($J,"PRS8",DY,"HW")=$G(^TMP($J,"PRS8",DY,"HW"))_$P(V,U,1,2)_U
     20 ..Q
     21 .I TYP["P",$P(V,"^",2)>96 S LEN=$P(V,"^",2)-96 D  ;two day tour of HW for part timers
     22 ..S ^TMP($J,"PRS8",DY+1,"HWK")=$G(^TMP($J,"PRS8",DY+1,"HWK"))_1_U_LEN_U
     23 ..K LEN
     24 ..Q
     25 .I TYP["P",TYP["N"!(TYP["H"),'$E(DAY(DY,"W"),+V) D  ; part time nurses, uscheduled HW.
     26 ..S ^TMP($J,"PRS8",DY,"HWK")=$G(^TMP($J,"PRS8",DY,"HWK"))_$P(V,U,1,2)_U
     27 ..Q
     28 .Q
     29 S X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL" ;code
     30 S X=($F(X,"^"_TT)\3)+4,(X,TT(1))=$P($T(ACT+X),";;",2) ;parameters
     31 S GO=0 I '+X!($E(ENT,+X)) S GO=1 ;entitlement exists-continue
     32 I TT="RG",$E(ENT,2)'=0 S GO=1 ;intermittent
     33 I TT="RG"!(TT="CP"),$E(ENT,2)="D" S DAY(DY,"DWK")=1 ;intrmtnt-count days worked (for RG or CP)
     34 I TT="OT",'GO,$E(ENT,13)!$E(ENT,14) S GO=1 ;entitled to ot
     35 I TT="UN" S GO=1,VAR="-" ;unavailable
     36 I TYP["W",TT="RG",$P(V,"^",4)=7 D
     37 .;wage grade employee working regular unscheduled hours for
     38 .;shift coverage (7) can get shift differential based on the higher
     39 .;of the unscheduled tour's shift or their normal shift.
     40 .;The unscheduled tour and corresponding differential will be saved
     41 .;in the "SD" node and used by PRS8PP when differentials are
     42 .;computed.
     43 .N ST,EN,SD,MID
     44 .S ST=$P(V,"^"),EN=$P(V,"^",2) Q:'ST!'EN
     45 .S MID=ST+EN/2
     46 .; check for 2day tour and if found use combined tour (recompute MID)
     47 .; to determine appropriate shift differential.
     48 .; if start is 1 (midnight) then check previous day for a similar tour
     49 .; that ended at 96 (midnight).
     50 . I ST=1 D
     51 .. N PRSI,PRSX
     52 .. S PRSX=$G(^TMP($J,"PRS8",DY-1,2))
     53 .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)=""  D
     54 ... I $P(PRSX,U,(PRSI-1)*4+2)=96,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=($P(PRSX,U,(PRSI-1)*4+1)+EN+96)/2
     55 .; if end is 96 (midnight) then check next day for a similar tour that
     56 .; starts at 1 (midnight).
     57 . I EN=96 D
     58 .. N PRSI,PRSX
     59 .. S PRSX=$G(^TMP($J,"PRS8",DY+1,2))
     60 .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)=""  D
     61 ... I $P(PRSX,U,(PRSI-1)*4+1)=1,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=(ST+$P(PRSX,U,(PRSI-1)*4+2)+96)/2
     62 .; determine shift differential (if any) based on unscheduled tour hours
     63 .S SD=0
     64 .I MID<32.5 S SD=3 ; majority of tour before 8a
     65 .I MID>60.5,MID'>94.5 S SD=2 ; majority of tour after 3p, upto 11:30p
     66 .I MID>94.5,MID<128.5 S SD=3 ; majority of tour after 11:30p, before 8a
     67 .; use employee's normal shift if higher than shift based on hours
     68 .I TOUR>1,TOUR>SD S SD=TOUR
     69 .S:SD ^TMP($J,"PRS8",DY,"SD")=$G(^TMP($J,"PRS8",DY,"SD"))_ST_U_EN_U_SD_U
     70 .Q
     71 I (TT="OT"!(TT="RG")!(TT="CT")),"^13^14^"[("^"_$P(V,"^",4)_"^")!($P(V,"^",4)=12&(TYP["N"!(TYP["H"))) D
     72 .S ^TMP($J,"PRS8",DY,"CB")=$G(^TMP($J,"PRS8",DY,"CB"))_$P(V,"^",1,2)_"^"
     73 .Q
     74 I TYP'["D",TT="HX"!(TT="HW") S GO=1 ;process holiday excused/worked
     75 G END:'GO ;nothing to process
     76 I TT'="UN" S VAR=$P(X,"^",3) ;increment time code
     77 I '$S(VAR'="W":1,'CYA:1,DY<CYA:1,1:0) D
     78 .S WPCY=1 ;flag to save WOP in hours from 1/1 for calander year adjustment
     79 I TYP'["D" D  G END ;process hourly people and quit
     80 .; The following 2 lines commented out because for Employees that are
     81 .; non-daily tour (TYP'["D"), policy is has been described that all
     82 .; ML/COP has to be posted by time-keeper.
     83 .; If this changes, then uncomment these lines, remove the line adding
     84 .; military leave and COP that follows, and refer to routine PRS8UP.
     85 .; I VAR="M" S ^TMP($J,"PRS8",DY,"ML")=1,MILV=1 ;military leave taken
     86 .; I VAR="V" S ^TMP($J,"PRS8",DY,"CP")=1,WCMP=1 ;cont of pay indicator
     87 .I DY>0,DY<15 D
     88 ..; Post ML for employees who are charged in days.
     89 ..I VAR="M",$$MLINHRS^PRSAENT(DFN)=0 D
     90 ...S X=$P(TT(1),"^",4) D SET ; military leave & auth. absence
     91 ..I VAR="V",'$G(^TMP($J,"PRS8",DY,"CP")) S X="M",^TMP($J,"PRS8",DY,"CP")=1 D SET ; COP
     92 ..Q
     93 .D ^PRS8AC ;update activity string
     94 .Q
     95 ; Employees with daily tours (TYP["D")
     96 I DY>0,DY<15,VAR="M" S X=$P(TT(1),"^",4) D SET S X=5 D SET G END ;military leave & auth. absence
     97 I DY>0,DY<15,$$HOLIDAY^PRS8UT(PY,DFN,DY) D  G END ;holiday-no charge
     98 .I TT="RG" S DAY(DY,"W")=VAR,X=$S('$E(ENT,TOUR+21):9,1:TOUR+28) D SET ; If worked on holiday count it.
     99 .Q
     100 S D=DY
     101 I TT="NP"!($P(DAY(D,0),"^",2)'=1) S DAY(D,"W")=VAR,X=$P(TT(1),"^",4) I X'="",DY>0,DY<15 D SET I VAR="V" S X="M" D SET I VAR="V",TYP["DI",$E(ENT,2)="D" S X=9 D SET ; IF INT RESDNT PAID IN DAYS HAS COP POSTED PAY UN/US ALSO
     102 D ENCAP^PRS8EX0
     103 ;
     104END ; --- all done here     
     105 K A,D,DD,GO,TT,X,Z
     106 Q
     107 ;
     108SET ; --- enter here to set without VAL defined
     109 ; Quit if this day has already been counted through the encapsulation
     110 ; check that is performed in ENCAP^PRS8EX0.
     111 Q:$D(^TMP($J,"PRS8",DY,2,0))
     112 ;
     113 Q:X="K"&($P(V,"^",1)>96)!((X="K")&($D(^TMP($J,"PRS8",DY,"ML"))))  S ^TMP($J,"PRS8",DY,"ML")=1 ;stop counting ML twice for two day tours & split tours, but allow PC
     114 I +X S $P(WK(WK),"^",+X)=$P(WK(WK),"^",+X)+1
     115 E  S X=$A(X)-64,$P(WK(3),"^",+X)=$P(WK(3),"^",+X)+1
     116 Q
     117 ;
     118ACT ; --- define variable X for action
     119 ;     - piece 1 = entitlement (ENT) string $Extract to check
     120 ;     -       2 = Literal name of exception
     121 ;     -       3 = Time String code (DAY(X,"W"))
     122 ;;
     123 ;;30^Annual Leave^L^1
     124 ;;31^Sick Leave^S^2
     125 ;;33^Without Pay^W^3
     126 ;;36^Non-Pay Status^n^4
     127 ;;35^Authorized Absence^A^5
     128 ;;30^Restored Leave^R^6
     129 ;;28^Comp Used^U^8
     130 ;;28^Comp Earned^E^7
     131 ;;37^Continuation of Pay^V^33
     132 ;;38^Holiday Excused^H
     133 ;;34^Military Leave^M^K
     134 ;;0^Training^X^43
     135 ;;0^Travel^Y^42
     136 ;;12^Overtime^O
     137 ;;2^Unscheduled^4^9
     138 ;;18^OT in Travel Status^T
     139 ;;29^Standby^B
     140 ;;26^On-Call^C
     141 ;;36^Nonpay A/L^N^A
     142 ;;38^Holiday Worked^h
     143 ;;31^Care and Bereavement^F^44
     144 ;;31^Adoption^G^45
     145 ;;35^Donor Leave^D^46
Note: See TracChangeset for help on using the changeset viewer.