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