source: WorldVistAEHR/trunk/r/PAID-PRS/PRSARC09.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRSARC09 ;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 ;
6AUTOREC(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 ;
34ADDAUTOR(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 ;
Note: See TracBrowser for help on using the repository browser.