Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRS8OC.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/PRS8OC.m (modified) (7 diffs)

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

@@ -1 @@
-PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/27/07
- ;;4.0;PAID;**63,92,112**;Sep 21, 1995;Build 54
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/17/04
+ ;;4.0;PAID;**63,92**;Sep 21, 1995         
  ;
  ;The following MUMPS code is used to credit the appropriate
@@ -34 +33 @@
 OCS ; --- set On-Call minimum hours
  ;set YA/YE for PPI="W" or "V" else set OT
- I +NAWS=0 S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
- I +NAWS S Y=$S(CC:7,1:TOUR+19)
- ;
+ S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
  N X,Z,DD,TT,CCCNT,NEXTT,OCCNT,TIMECNT
  S TT=$S(T>96:T-96,1:T),TIMECNT=0
@@ -83 +80 @@
  ..I OC+CNTR'>8 D
  ...S Y(1)=$S(X=1:OC,1:8-CNTR)
- ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses
- ...I +NAWS D CHOL1 ; Process AWS nurses
+ ...D CHOL
  ...S (OC,OC(D),CC,CC(D))=0,FG=1
  ..Q
@@ -98 +94 @@
  ..I OC+CNTR'>8 D
  ...S Y(1)=$S(X=1:OC,1:8-CNTR)
- ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses
- ...I +NAWS D CHOL1 ; Process AWS nurses
+ ...D CHOL
  ...S (OC,OC(D),CC,CC(D))=0,FG=1
  ..Q
@@ -118 +113 @@
  ...;
  ..S Y(1)=$S(X=2:CC(I)+CCCNT,X:CC(I),OC(I)>7:CC(I),1:4),Y=7
- ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
- ..I +NAWS D CHOL1 ; Process AWS nurses
+ ..D CHOL
  ..S Y(1)=$S(X=2:OC(I)-CC(I)+OCCNT,X:OC(I)-CC(I),OC(I)>7:OC(I)-CC(I),1:4)
  ..S Y=$S('DOUB:TOUR+19,1:23)
- ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
- ..I +NAWS D CHOL1 ; Process AWS nurses
+ ..D CHOL
  ..Q
  .Q
@@ -132 +125 @@
  ...I T=96,"ct"'[$E(DAY(DAY+1,"W"),1) S OC(I)=8-TIMECNT
  ..S Y(1)=$S(X:OC(I),OC(I)>7:OC(I),1:8)
- ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
- ..I +NAWS D CHOL1 ; Process AWS nurses
+ ..D CHOL
  ..Q
  .Q
@@ -155 +147 @@
  E  S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+Y(1)
  Q
- ;
-CHOL1 ; Checks for AWS nurses
- N HT,J,K,T2ADD
- S K=0,TMP=Y,Y=0
- S T2ADD=$S(CC:Y(1)-CC,1:Y(1)-OC-CC)
- ; Apply normal checks for OT on Hol and Hol Callback
- I TMP'=7,$E(ENT,25),$$HOLIDAY^PRS8UT(PY,DFN,+D) S Y=24 ;ot on actual hol
- I 'Y,$E($G(DAY(I,"HOL")),$S(T>96:(T-96),1:T)) S Y=TOUR+28 ;holiday callback
- I 'Y S Y=TMP
- I Y=24!(Y=(TOUR+28)) D SET Q
- ; If not OT on Hol or Hol Callback Determine if we are setting OT or CT
- S K=$S(Y=7:CC,1:OC)
- F J=1:1:K D AWSWK ; Update actual time worked
- F J=1:1:T2ADD D AWSWK ; Update time added to reach 2 hour min
- Q
- ;
-AWSWK ; Determine what type of time to add based on 8/day and 40/wk
- S HT=+$G(^TMP($J,"PRS8",D,"HT"))
- I HT'<32 S Y=$S(Y'=7:TOUR+15,1:Y) D SET1 Q
- I TH(W)'<160 S Y=$S(Y'=7:TOUR+19,1:Y) D SET1 Q
- I HT<32,TH(W)<160 S Y=9 D SET1
- Q
- ;
-SET1 ; Set WK array for AWS nurses
- S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+1
- Q:HT'<32
- S TH=TH+1,TH(WK)=TH(WK)+1
- S ^TMP($J,"PRS8",DAY,"HT")=HT+1
- Q