PRSARC09 ;WOIFO/JAH - automatically load continuous recess;5/31/07
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
AUTOREC(AWSST,AWSEND) ; Ask user: automatically schedule all available
; recess, continuously from a user specified date.
W @IOF,!!
N DIR,X,Y,DIRUT,I
S DIR("A")="Set available recess, continously from a particular date"
S DIR("?",1)=" You may now select a recess start date and all available "
S DIR("?",2)=" recess will automatically be scheduled fully for each "
S DIR("?",3)=" week from the date you pick. If you answer NO, you may"
S DIR("?",4)=" schedule recess by selecting weeks in the recess editor."
S DIR("?",5)=" "
S DIR("?",6)=" There are "_$P(PRSRWHRS,U,3)_" weeks or "_$P(PRSRWHRS,U,2)_" hours available for recess."
S I=0 F S I=$O(DIR("?",I)) Q:I'>0 W !,DIR("?",I)
S DIR("B")="YES"
S DIR(0)="Y"
D ^DIR
S (PRSAUTOR)=+Y
Q:'PRSAUTOR 0
; Find last date recess can start
N X,X1,X2,RECSTART
S X2=-(7*(($P(PRSRWHRS,U,3)+.9\1)-1)),X1=AWSEND D C^%DTC S AWSEND=X
S RECSTART=$$AWSTART^PRSARC03(AWSST,AWSEND,"Enter Recess Start Date")
Q:RECSTART'>0 0
; convert RECESS start to 1st day of week
N D1,DAY,PPI,PPE S D1=RECSTART D PP^PRSAPPU
N X1,X2,X,%H S X1=D1,X2=-$S(DAY<8:DAY-1,1:DAY-8) D C^%DTC S RECSTART=X
Q PRSAUTOR_U_RECSTART
;
;
ADDAUTOR(PRSAUTOR) ; auto add recess to listman
;
N LSTITEM,CTRH1,CTRH2,LOFHRS,LOFTH1,LOFTH2,WKDY1
N ITEM,Y,RH1,RH2,OUT,HRSLEFT,RDEFAULT,CRH,TOURHRS,D1,PPI,PPE
;
; get tour hours from latest pay period on file
N PPI S PPI=$O(^PRST(458,999999),-1)
N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
S LOFTH1=TH("W1"),LOFTH2=TH("W2")
;
; Initialize hours left for recess to 20 since 1 pay period minimum
; is 25% of 80 hours
S HRSLEFT=20
S (OUT,ITEM,RDEFAULT)=0
S WKDY1=$P(PRSAUTOR,U,2)-1
F S WKDY1=$O(FMWKS(WKDY1)) Q:WKDY1'>0!(HRSLEFT'>0) D
. S HRSLEFT=$$HRSLEFT^PRSARC03()
. Q:HRSLEFT'>0
. S ITEM=$G(FMWKS(WKDY1))
. S LSTITEM=$G(^TMP("PRSLI",$J,ITEM))
. S D1=WKDY1 D PP^PRSAPPU
. N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
. S CTRH1=+TH("W1"),CTRH2=+TH("W2")
. S TOURHRS=$S(ITEM#2:CTRH1,1:CTRH2)
. S LOFHRS=$S(ITEM#2:LOFTH1,1:LOFTH2)
. I TOURHRS'>0 S TOURHRS=LOFHRS
. ;get remaining hours to schedule for FY
. I HRSLEFT<TOURHRS D
.. S RDEFAULT=HRSLEFT
. E D
.. S RDEFAULT=TOURHRS
. I RDEFAULT<0 S RDEFAULT=0
. D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J(RDEFAULT,15,2))
.;
.; set hrs for selected weeks, remove from array if zero
.;
. I RDEFAULT'>0 D
.. K ^TMP("PRSRW",$J,ITEM)
. E D
.. S ^TMP("PRSRW",$J,ITEM)=LSTITEM_U_RDEFAULT_U_WKDY1_U_"0"
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC09 2741 printed Dec 13, 2024@02:24:12 Page 2
PRSARC09 ;WOIFO/JAH - automatically load continuous recess;5/31/07
+1 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
AUTOREC(AWSST,AWSEND) ; Ask user: automatically schedule all available
+1 ; recess, continuously from a user specified date.
+2 WRITE @IOF,!!
+3 NEW DIR,X,Y,DIRUT,I
+4 SET DIR("A")="Set available recess, continously from a particular date"
+5 SET DIR("?",1)=" You may now select a recess start date and all available "
+6 SET DIR("?",2)=" recess will automatically be scheduled fully for each "
+7 SET DIR("?",3)=" week from the date you pick. If you answer NO, you may"
+8 SET DIR("?",4)=" schedule recess by selecting weeks in the recess editor."
+9 SET DIR("?",5)=" "
+10 SET DIR("?",6)=" There are "_$PIECE(PRSRWHRS,U,3)_" weeks or "_$PIECE(PRSRWHRS,U,2)_" hours available for recess."
+11 SET I=0
FOR
SET I=$ORDER(DIR("?",I))
if I'>0
QUIT
WRITE !,DIR("?",I)
+12 SET DIR("B")="YES"
+13 SET DIR(0)="Y"
+14 DO ^DIR
+15 SET (PRSAUTOR)=+Y
+16 if 'PRSAUTOR
QUIT 0
+17 ; Find last date recess can start
+18 NEW X,X1,X2,RECSTART
+19 SET X2=-(7*(($PIECE(PRSRWHRS,U,3)+.9\1)-1))
SET X1=AWSEND
DO C^%DTC
SET AWSEND=X
+20 SET RECSTART=$$AWSTART^PRSARC03(AWSST,AWSEND,"Enter Recess Start Date")
+21 if RECSTART'>0
QUIT 0
+22 ; convert RECESS start to 1st day of week
+23 NEW D1,DAY,PPI,PPE
SET D1=RECSTART
DO PP^PRSAPPU
+24 NEW X1,X2,X,%H
SET X1=D1
SET X2=-$SELECT(DAY<8:DAY-1,1:DAY-8)
DO C^%DTC
SET RECSTART=X
+25 QUIT PRSAUTOR_U_RECSTART
+26 ;
+27 ;
ADDAUTOR(PRSAUTOR) ; auto add recess to listman
+1 ;
+2 NEW LSTITEM,CTRH1,CTRH2,LOFHRS,LOFTH1,LOFTH2,WKDY1
+3 NEW ITEM,Y,RH1,RH2,OUT,HRSLEFT,RDEFAULT,CRH,TOURHRS,D1,PPI,PPE
+4 ;
+5 ; get tour hours from latest pay period on file
+6 NEW PPI
SET PPI=$ORDER(^PRST(458,999999),-1)
+7 NEW TH
DO TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
+8 SET LOFTH1=TH("W1")
SET LOFTH2=TH("W2")
+9 ;
+10 ; Initialize hours left for recess to 20 since 1 pay period minimum
+11 ; is 25% of 80 hours
+12 SET HRSLEFT=20
+13 SET (OUT,ITEM,RDEFAULT)=0
+14 SET WKDY1=$PIECE(PRSAUTOR,U,2)-1
+15 FOR
SET WKDY1=$ORDER(FMWKS(WKDY1))
if WKDY1'>0!(HRSLEFT'>0)
QUIT
Begin DoDot:1
+16 SET HRSLEFT=$$HRSLEFT^PRSARC03()
+17 if HRSLEFT'>0
QUIT
+18 SET ITEM=$GET(FMWKS(WKDY1))
+19 SET LSTITEM=$GET(^TMP("PRSLI",$JOB,ITEM))
+20 SET D1=WKDY1
DO PP^PRSAPPU
+21 NEW TH
DO TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
+22 SET CTRH1=+TH("W1")
SET CTRH2=+TH("W2")
+23 SET TOURHRS=$SELECT(ITEM#2:CTRH1,1:CTRH2)
+24 SET LOFHRS=$SELECT(ITEM#2:LOFTH1,1:LOFTH2)
+25 IF TOURHRS'>0
SET TOURHRS=LOFHRS
+26 ;get remaining hours to schedule for FY
+27 IF HRSLEFT<TOURHRS
Begin DoDot:2
+28 SET RDEFAULT=HRSLEFT
End DoDot:2
+29 IF '$TEST
Begin DoDot:2
+30 SET RDEFAULT=TOURHRS
End DoDot:2
+31 IF RDEFAULT<0
SET RDEFAULT=0
+32 DO FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$JUSTIFY(RDEFAULT,15,2))
+33 ;
+34 ; set hrs for selected weeks, remove from array if zero
+35 ;
+36 IF RDEFAULT'>0
Begin DoDot:2
+37 KILL ^TMP("PRSRW",$JOB,ITEM)
End DoDot:2
+38 IF '$TEST
Begin DoDot:2
+39 SET ^TMP("PRSRW",$JOB,ITEM)=LSTITEM_U_RDEFAULT_U_WKDY1_U_"0"
End DoDot:2
End DoDot:1
+40 ;
+41 QUIT
+42 ;
