Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRS8ST.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PAID-PRS/PRS8ST.m (modified) (9 diffs)

FOIAVistA/tag/r/PAID-PRS/PRS8ST.m

@@ -1 @@
-PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;05/09/07
- ;;4.0;PAID;**45,92,102,112**;Sep 21, 1995;Build 54
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;12/12/05
+ ;;4.0;PAID;**45,92,102**;Sep 21, 1995
  ;
  ;This routine is the one which actually gets everything moving.
@@ -15 +14 @@
  .S LP=$S(DAY=1:"0,1,2",1:(DAY+1)),JURY=0
  .F II=1:1 S DY=$P(LP,",",II) Q:DY=""  D
- ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","r" D
+ ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W" D
  ...S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))
  ...;
@@ -26 +25 @@
  ..S WK=$S(DY<8:1,1:2)
  ..S TOUR=$S(TYP'["W":1,+DAY(DY,"TOUR"):+DAY(DY,"TOUR"),1:+TOUR(WK))
- ..D MOVE^PRS8AC
- ..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week
+ ..D MOVE^PRS8AC S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week
  ..I N["UN" S X1="UN" D 2 ;unavailable
  ..I N["HX" S X1="HX" D 2 ;holiday excused
  ..I N["ON" S X1="ON" D 2 ;on-call
  ..I N["SB" S X1="SB" D 2 ;standby
- ..; Process the scheduled tours
  ..S N=DAY(DY,1),DH=DAY(DY,"DH1"),NN=1 D  I DAY(DY,"TWO") S N=DAY(DY,4),DH=DAY(DY,"DH2"),NN=4 D
  ...S QT=0 F PRS8=1:3 S V=$P(N,"^",PRS8,PRS8+2) Q:QT  D
@@ -51 +48 @@
  .....F J=4,8,12,16,20,24,28 S:$P(JURY,"^",J)=6 JURY=1 Q
  ....D ^PRS8AC ;build "W" node
- ..; Process the exceptions
  ..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week
- ..S QT=0
- ..; If there are Recess exceptions, process them first
- ..I N["RS" D
- ...; Since Recess will reduce hours worked in the week add P to TYP
- ...I TYP'["P" S TYP=TYP_"P"
- ...F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT  D
- ....Q:$P(V,"^",3)='"RS"
- ....I TYP["D",$P(V,"^",3)="" S QT=1 Q  ;doctor
- ....I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q  ;all others
- ....S X=$P(V,"^",3)
- ....I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX
- ...;
- ...; Process all other types of exceptions
- ..S QT=0
- ..F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT  D
- ...Q:$P(V,"^",3)="RS"
+ ..S QT=0 F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT  D
  ...I TYP["D",$P(V,"^",3)="" S QT=1 Q  ;doctor
  ...I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q  ;all others
- ...S X=$P(V,"^",3)
- ...I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX
- ..;
+ ...S X=$P(V,"^",3) I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX
  ..S ^TMP($J,"PRS8",DY,"W")=DAY(DY,"W") ;save in ^TMP
  ..S ^TMP($J,"PRS8",DY,"P")=DAY(DY,"P") ;save non-prem ot in ^TMP
  ..S ^TMP($J,"PRS8",DY,"HOL")=DAY(DY,"HOL") ;holiday
- ..S ^TMP($J,"PRS8",DY,"r")=DAY(DY,"r") ; Recess for 9mo AWS nurse
  .S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off
  .S TOUR=$S(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK))
@@ -86 +64 @@
  .Q
  ;
- ;make DAY array available for prior, current, and next day
  F DAY=1:1:14 D
- .; I AWS Nurse check to see if hour counts need to be adjusted
- .S WK=$S(DAY<8:1,1:2)
- .; For each week, TYP should not contain "P" unless:
- .; 36/40 AWS has NP or WP
- .;   9mo AWS has Recess
- .I +NAWS,(DAY=1!(DAY=8)) S TYP=$TR(TYP,"P","") D NAWS
- .;
+ .;make DAY array available for prior, current, and next day
  .K DAY(DAY-2)
  .S LP=$S(DAY=1:"0,1,2",1:(DAY+1))
  .F II=1:1 S DY=$P(LP,",",II) Q:DY=""  D
- ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F","r" S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))
+ ..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F" S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))
  .;
  .S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off
@@ -104 +75 @@
  .;
  .I ((TYP["I")!(TYP["P")),DAY>0,DAY<15 D  ;FOR CY
- ..I $S('CYA:1,DAY<CYA:1,1:0) Q  ;quit if no calendar year adjustment
+ ..I $S('CYA:1,DAY<CYA:1,1:0) Q  ;quit if no calander year adjustment
  ..S IIX=0 I $E(ENT,2)'="D" F II=1:1:$L(DAY(DAY,"W")) D
  ...I "4E"[$E(DAY(DAY,"W"),II) S IIX=IIX+1
@@ -119 +90 @@
  ...I T=96!("BbCct"'[$E(DAY(DAY,"W"),T+1)) S OK=T
  ...I DOUB D ^PRS8OC,^PRS8SB Q  ;Prem. Pay of "W" or "V"
- ...I VAR1'=""&("Cct"[VAR1) D ^PRS8OC Q  ;compute on-call/2hr minimum
+ ...I VAR1'=""&("Cct"[VAR1) D ^PRS8OC Q  ;compte on-call/2hr minimum
  ...I "Bb"[VAR1 D ^PRS8SB ;standby
  .I $G(SBY) D UP^PRS8SB
@@ -141 +112 @@
  I '$E(ENT,$P("12^28^^29^26^^^29","^",+X)) S Q=1 ;entitlement string
  ;PATCH 45: ADD CHECK FOR FIRE FIGHTER ADDITIONAL HOURS
- ;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITLEMENT TABLE
+ ;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITLMENT TABLE
  ;IT IS SET UP WITH TOUR IND. WITH CODE 9
  I "Ff"[TYP,X=9 S Q=0
@@ -150 +121 @@
  F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+2) Q:$P(V,"^",1)=""  D
  .S X=$P(V,"^",3) I X=X1 D ^PRS8EX
- K PRS8,X,V
- Q
- ;
-NAWS ; NAWS Nurse Alternate Work Schedules
- ; If any NP or WP has been incurred for a nurse on the 36/40 AWS,
- ; adjust their hours worked counts.  40 hrs/wk will now be used to 
- ; determine their qualification for OT and CT.  Check piece 16 of
- ; 0 node as NH will have been updated to 320 in PRS8SU.
- ;
- I +NAWS=36 D
- .Q:$P(WK(WK),U,3)=""&($P(WK(WK),U,4)="")
- .S TH(WK)=144-($P(WK(WK),U,3)+$P(WK(WK),U,4)) ; Adjust Total Hours per week
- .S TH=TH(1)+TH(2) ; Adjust Total Hours per pay period
- .S NH(WK)=144,NH=288 ; Adjust Normal Hours
- .I TYP'["P" S TYP=TYP_"P" ; Make them into a PT employee
- .S $E(ENT,2)=1 ; Make employee eligible for UN/US
- ;
- ; If any Recess has occurred for a nurse on the 9month AWS, adjust 
- ; their hours worked counts.  These employees will be treated as PT
- ; in determining the eligibility for OT/CT.
- ;
- I +NAWS=9 D
- .Q:$P(WK(WK),U,48)=""
- .S TH(WK)=TH(WK)-$P(WK(WK),U,48) ; Adjust total hours per week
- .S TH=TH(1)+TH(2) ; Adjust Total Hours
- .I TYP'["P" S TYP=TYP_"P" ; Adjust TYP to represent a PT employee
- Q
+ K PRS8,X,V Q