| 1 | PRSARC09 ;WOIFO/JAH - automatically load continuous recess;5/31/07
|
|---|
| 2 | ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | AUTOREC(AWSST,AWSEND) ; Ask user: automatically schedule all available
|
|---|
| 7 | ; recess, continuously from a user specified date.
|
|---|
| 8 | W @IOF,!!
|
|---|
| 9 | N DIR,X,Y,DIRUT,I
|
|---|
| 10 | S DIR("A")="Set available recess, continously from a particular date"
|
|---|
| 11 | S DIR("?",1)=" You may now select a recess start date and all available "
|
|---|
| 12 | S DIR("?",2)=" recess will automatically be scheduled fully for each "
|
|---|
| 13 | S DIR("?",3)=" week from the date you pick. If you answer NO, you may"
|
|---|
| 14 | S DIR("?",4)=" schedule recess by selecting weeks in the recess editor."
|
|---|
| 15 | S DIR("?",5)=" "
|
|---|
| 16 | S DIR("?",6)=" There are "_$P(PRSRWHRS,U,3)_" weeks or "_$P(PRSRWHRS,U,2)_" hours available for recess."
|
|---|
| 17 | S I=0 F S I=$O(DIR("?",I)) Q:I'>0 W !,DIR("?",I)
|
|---|
| 18 | S DIR("B")="YES"
|
|---|
| 19 | S DIR(0)="Y"
|
|---|
| 20 | D ^DIR
|
|---|
| 21 | S (PRSAUTOR)=+Y
|
|---|
| 22 | Q:'PRSAUTOR 0
|
|---|
| 23 | ; Find last date recess can start
|
|---|
| 24 | N X,X1,X2,RECSTART
|
|---|
| 25 | S X2=-(7*(($P(PRSRWHRS,U,3)+.9\1)-1)),X1=AWSEND D C^%DTC S AWSEND=X
|
|---|
| 26 | S RECSTART=$$AWSTART^PRSARC03(AWSST,AWSEND,"Enter Recess Start Date")
|
|---|
| 27 | Q:RECSTART'>0 0
|
|---|
| 28 | ; convert RECESS start to 1st day of week
|
|---|
| 29 | N D1,DAY,PPI,PPE S D1=RECSTART D PP^PRSAPPU
|
|---|
| 30 | N X1,X2,X,%H S X1=D1,X2=-$S(DAY<8:DAY-1,1:DAY-8) D C^%DTC S RECSTART=X
|
|---|
| 31 | Q PRSAUTOR_U_RECSTART
|
|---|
| 32 | ;
|
|---|
| 33 | ;
|
|---|
| 34 | ADDAUTOR(PRSAUTOR) ; auto add recess to listman
|
|---|
| 35 | ;
|
|---|
| 36 | N LSTITEM,CTRH1,CTRH2,LOFHRS,LOFTH1,LOFTH2,WKDY1
|
|---|
| 37 | N ITEM,Y,RH1,RH2,OUT,HRSLEFT,RDEFAULT,CRH,TOURHRS,D1,PPI,PPE
|
|---|
| 38 | ;
|
|---|
| 39 | ; get tour hours from latest pay period on file
|
|---|
| 40 | N PPI S PPI=$O(^PRST(458,999999),-1)
|
|---|
| 41 | N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
|
|---|
| 42 | S LOFTH1=TH("W1"),LOFTH2=TH("W2")
|
|---|
| 43 | ;
|
|---|
| 44 | ; Initialize hours left for recess to 20 since 1 pay period minimum
|
|---|
| 45 | ; is 25% of 80 hours
|
|---|
| 46 | S HRSLEFT=20
|
|---|
| 47 | S (OUT,ITEM,RDEFAULT)=0
|
|---|
| 48 | S WKDY1=$P(PRSAUTOR,U,2)-1
|
|---|
| 49 | F S WKDY1=$O(FMWKS(WKDY1)) Q:WKDY1'>0!(HRSLEFT'>0) D
|
|---|
| 50 | . S HRSLEFT=$$HRSLEFT^PRSARC03()
|
|---|
| 51 | . Q:HRSLEFT'>0
|
|---|
| 52 | . S ITEM=$G(FMWKS(WKDY1))
|
|---|
| 53 | . S LSTITEM=$G(^TMP("PRSLI",$J,ITEM))
|
|---|
| 54 | . S D1=WKDY1 D PP^PRSAPPU
|
|---|
| 55 | . N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
|
|---|
| 56 | . S CTRH1=+TH("W1"),CTRH2=+TH("W2")
|
|---|
| 57 | . S TOURHRS=$S(ITEM#2:CTRH1,1:CTRH2)
|
|---|
| 58 | . S LOFHRS=$S(ITEM#2:LOFTH1,1:LOFTH2)
|
|---|
| 59 | . I TOURHRS'>0 S TOURHRS=LOFHRS
|
|---|
| 60 | . ;get remaining hours to schedule for FY
|
|---|
| 61 | . I HRSLEFT<TOURHRS D
|
|---|
| 62 | .. S RDEFAULT=HRSLEFT
|
|---|
| 63 | . E D
|
|---|
| 64 | .. S RDEFAULT=TOURHRS
|
|---|
| 65 | . I RDEFAULT<0 S RDEFAULT=0
|
|---|
| 66 | . D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J(RDEFAULT,15,2))
|
|---|
| 67 | .;
|
|---|
| 68 | .; set hrs for selected weeks, remove from array if zero
|
|---|
| 69 | .;
|
|---|
| 70 | . I RDEFAULT'>0 D
|
|---|
| 71 | .. K ^TMP("PRSRW",$J,ITEM)
|
|---|
| 72 | . E D
|
|---|
| 73 | .. S ^TMP("PRSRW",$J,ITEM)=LSTITEM_U_RDEFAULT_U_WKDY1_U_"0"
|
|---|
| 74 | ;
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
