Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSATE0

PRSATE0.m

Go to the documentation of this file.
  1. PRSATE0 ;WCIOFO/PLT - Data Validate for Edit Variable Tours ;7/18/08 14:37
  1. ;;4.0;PAID;**112,117,132**;Sep 21, 1995;Build 13
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. N PRSTWO
  1. S TOLD="" F K=1:1:14 S Z=$P($G(^PRST(458,PPI,"E",DFN,"D",K,0)),"^",2),$P(TOLD,"^",K)=Z S:SRT="N"&$P($G(^(0)),"^",3) $P(TOLD,"^",K)=$P(^(0),"^",4) S:PRSTWB (PRSTW(K),PRSTWO(K))=$P($G(^(8)),U,$S(SRT="N"&$P($G(^(0)),"^",3):5,1:1))
  1. K K S ^PRST(458,PPI,"E",DFN,"T")=TOLD D DT^PRSATE2
  1. N DDSFILE,DA,DR,PRSAERR,DDSBR
  1. S DDSFILE=458,DDSFILE(1)=458.01,DA(1)=PPI,DA=DFN
  1. S DR="[PRSA TE EDIT]" D ^DDS K DS Q:$D(PRSAERR)
  1. S TNEW=$G(^PRST(458,PPI,"E",DFN,"T")) K ^PRST(458,PPI,"E",DFN,"T")
  1. I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14"
  1. F DAY=1:1:14 S TD=$P(TNEW,"^",DAY) I TD>0 D S1
  1. K TNEW,TOLD
  1. QUIT
  1. ;
  1. S1 ; Set Tour if necessary
  1. I '$G(PRSTWB),$D(^PRST(458,PPI,"E",DFN,"D",DAY,8)) K ^PRST(458,PPI,"E",DFN,"D",DAY,8)
  1. I TD=$P(TOLD,"^",DAY),$G(^PRST(457.1,+TD,1))=$G(^PRST(457.1,+$P(TOLD,"^",DAY),1)),$G(PRSTW(DAY))=$G(PRSTWO(DAY))!'$G(PRSTWB) QUIT
  1. I SRT'="N" S Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6) D SET^PRSATE QUIT
  1. D NX^PRSATE
  1. QUIT
  1. ;
  1. VS ; Validate tour segments
  1. S TRG=0 F K=1:3:19 Q:$P(Y,"^",K)="" S Z=$P(Y,"^",K+2) S:'Z TRG=1 I Z D
  1. . S Z=$P($G(^PRST(457.2,Z,0)),"^",2) I Z="RG" S TRG=1 Q
  1. . I ZENT'[Z S STR="Tour Indicator contains type of time to which employee is not entitled."
  1. . QUIT
  1. QUIT
  1. ;
  1. VAL ; Validate Tour
  1. K PRSETD,PRSDAY
  1. F DAY=1:1:14 S $P(PRSETD,U,DAY)=$$GET^DDSVAL(DIE,.DA,DAY+200)
  1. G:TOLD=PRSETD VAL2
  1. ;tour overlap validate
  1. ;load prsday(day) before save
  1. F DAY=1:1:14 S PRSDAY(DAY)=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),U,1,4),$P(PRSDAY(DAY),U,6)=$P($G(^(0)),U,13),$P(PRSDAY(DAY),U,7,999)=$G(^(4)) D PRSDAY
  1. ;check tour overlap
  1. D ENT^PRSATE5 I $G(PRSERR) S DDSERROR=1,DDSBR=PRSERR+10_"^1^1" K PRSERR QUIT
  1. ;
  1. VAL2 N NAWS,SNAWS,TDT S (ZENT,STR)="" K PRSAERR D OT^PRSATP S DB=$P(C0,U,10) I "KM"[PP,DB=1,NH=72 S NAWS=1
  1. S (HRS,TRS,TDT)=0 F DAY=1:1:14 D QUIT:STR'=""
  1. . S TD=$P(PRSETD,U,DAY),Z=$P($G(^PRST(457.1,+TD,0)),"^",6) S:Z HRS=HRS+Z S Y=$G(^(1))
  1. . I DAY=7!(DAY=14)&'TDT S TDT=$P($G(^PRST(457.1,+TD,0)),U,5)="Y"
  1. . I $D(NAWS) S:Z'=12&Z NAWS=0 S $P(SNAWS,U,DAY)=TD I Z=12 S NAWS(DAY-1\7+1)=$G(NAWS(DAY-1\7+1))+1
  1. . D VS S:TRG TRS=TRS+1
  1. . QUIT
  1. G:STR'="" V1
  1. I FLX="C",TRS>9 S STR="Warning: Compressed Schedule has more than 9 Tours!" D HLP^DDSUTL(.STR)
  1. I NH'=HRS,NH'=112 S STR="Warning: Normal Hours are "_NH_"; Tour Hours are "_HRS D HLP^DDSUTL(.STR)
  1. I $D(NAWS) D
  1. .I $G(NAWS(1))'=3!($G(NAWS(2))'=3)!'NAWS S STR=$P($T(NAWS1),";",3) D HLP^DDSUTL(.STR)
  1. .D TOURHRS^PRSARC07(.HRS,PPI,DFN,SNAWS)
  1. .I $G(HRS("W1"))'=36!($G(HRS("W2"))'=36) S STR=$P($T(NAWS2),";",3) D HLP^DDSUTL(.STR)
  1. .I $G(TDT) S STR=$P($T(NAWS3),";",3) D HLP^DDSUTL(.STR)
  1. K K,STR,TRG,TRS QUIT
  1. ;
  1. PRSDAY ;update prsday with new data (like codes in label set of prsate)
  1. I $P(PRSDAY(DAY),U,2)="" S $P(PRSDAY(DAY),U,1,3)=DAY_U_$P(PRSETD,U,DAY)_U_TYP QUIT:SRT'="N"
  1. I SRT="N" S $P(PRSDAY(DAY),"^",3,4)="2^"_$P(PRSETD,U,DAY) QUIT
  1. I $P(TOLD,U,DAY)=$P(PRSETD,U,DAY),$P($$TOUR^PRSATE5($P(PRSETD,U,DAY)),"~",2)=$G(^PRST(458,PPI,"E",DFN,"D",DAY,1)) QUIT
  1. I $P(PRSDAY(DAY),U,4)="" S $P(PRSDAY(DAY),U,2,4)=$P(PRSETD,U,DAY)_U_TYP_U_$P(PRSDAY(DAY),U,2)
  1. E I $P(PRSDAY(DAY),U,4)=$P(PRSETD,U,DAY) S $P(PRSDAY(DAY),U,2,4)=$P(PRSETD,U,DAY)_"^^"
  1. E S $P(PRSDAY(DAY),U,2,3)=$P(PRSETD,U,DAY)_U_TYP
  1. QUIT
  1. ;
  1. ;allow to file, ddserror is kill after set = 1, all other checks are aborted
  1. V1 S (DDSERROR,PRSAERR)=1 D HLP^DDSUTL(.STR) K DDSERROR Q
  1. NAWS1 ;;Warning: There are not three 12 hour tours in week 1 and/or week 2 for this AWS 36/40 Nurse
  1. NAWS2 ;;Warning: Hours in week 1 and/or week 2 are not 36 for this AWS 36/40 Nurse.
  1. NAWS3 ;;Warning: Tour overlaps two administrative work weeks for this 36/40 Nurse.
  1. ;
  1. ;a=ien of 450, b=[ien of 458], c=[ien (day # 1 to 14) of 458.02]
  1. ;d=[1 if pp/tem tour of dute, 5 if prior/next]
  1. TWE(A,B,C,D) ;ef=^1-emp 450 tw indicator, ^2=emp eligible code, ^3-emp pp 458 tw
  1. ; ^4 emp pp eliglble code, ^5-daily tw tour
  1. N E
  1. S:'$G(D) D=1 S E=$$TWP($P($G(^PRSPC(A,1)),U,45))
  1. QUIT:'$G(B) E
  1. QUIT E_U_$S("PX"[$P($G(^PRST(458,B,"E",A,0)),U,2):$$TWP($P($G(^(0)),U,8)),1:E)_$S($G(C):U_$P($G(^PRST(458,B,"E",A,"D",C,8)),U,D),1:"")
  1. ;
  1. ;a=telework paid code of file#454, [b=1 for return with description]
  1. TWP(A,B) ;ef=^1-telework code, ^2-eligible code, ^3-description
  1. QUIT:A="" U
  1. S A=$O(^PRSP(454,1,"TW","B",A,0)) QUIT:'A U
  1. S A=^PRSP(454,1,"TW",A,0)
  1. QUIT $P(A,U)_U_$P(A,U,3)_$S($G(B):U_$P(A,U,2),1:"")