| 1 | PRSARC06 ;WOIFO/JAH - Recess Tracking ListManger Inteface ;10/16/06
|
|---|
| 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 | MAIN(LSTART,LISTI,LINE,PRSDT,PRSFYRNG) ; BUILD LIST OF CALENDER FROM PP WITH PRSDT
|
|---|
| 6 | ; THROUGH PP CONTAINING SEPTEMBER 30
|
|---|
| 7 | ;
|
|---|
| 8 | ; PRSNMDT - date for new month
|
|---|
| 9 | ;
|
|---|
| 10 | ; Q:$G(PRSOUT)=1
|
|---|
| 11 | N FIRSTPP,PRSNMDT,FFPPE,LFPPE,EOFYDT,OUT,PRSDY,PRSMO,PRSNXTMO,PRSYR
|
|---|
| 12 | ;
|
|---|
| 13 | ; Get PP with PRSDT and convert PRSDT to the 1st day of that pp
|
|---|
| 14 | ;
|
|---|
| 15 | S FIRSTPP=$$GETPPDY^PRSARC04(PRSDT)
|
|---|
| 16 | S FFPPE=$P(FIRSTPP,U,2)
|
|---|
| 17 | S (PRSDT,PRSNMDT)=$P(FIRSTPP,U,1)
|
|---|
| 18 | ;
|
|---|
| 19 | ; lookup which week of the fiscal year the schedule begins
|
|---|
| 20 | ; this week # will be the first selectable item in the list
|
|---|
| 21 | ;
|
|---|
| 22 | S (LSTART,LISTI)=$G(FMWKS(PRSDT))
|
|---|
| 23 | ;
|
|---|
| 24 | ; Get the last PP of the fiscal year and it's last day.
|
|---|
| 25 | S LFPPE=$P(PRSFYRNG,U,4)
|
|---|
| 26 | S EOFYDT=$P(PRSFYRNG,U,2)
|
|---|
| 27 | ;
|
|---|
| 28 | ; if the first week in the AWS schedule is not both the 1st day
|
|---|
| 29 | ; of a PP and the first day of the month, then we need
|
|---|
| 30 | ; special code for that month, so that a partial month is used
|
|---|
| 31 | ; including only the pps that are part of the schedule.
|
|---|
| 32 | ;
|
|---|
| 33 | S (OUT,LINE,MONTHCNT)=0
|
|---|
| 34 | I $E(PRSDT,6,7)'="01" D
|
|---|
| 35 | . S STARTDAY=$E(PRSDT,6,7)
|
|---|
| 36 | . D ARAYMO(.LISTI,.LINE,PRSDT,MONTHCNT,STARTDAY,0)
|
|---|
| 37 | . S PRSMO=$E(PRSDT,4,5),PRSYR=$E(PRSDT,1,3),PRSDY=$E(PRSDT,6,7)
|
|---|
| 38 | . S PRSNXTMO=PRSMO+1 I $L(PRSNXTMO)=1 S PRSNXTMO="0"_PRSNXTMO
|
|---|
| 39 | . S PRSNMDT=$S(PRSMO=12:PRSYR+1_"01"_PRSDY,1:PRSYR_PRSNXTMO_"01")
|
|---|
| 40 | ;
|
|---|
| 41 | ; loop through the calendar building list items for every week in
|
|---|
| 42 | ; the year until we reach october. All agreements are through
|
|---|
| 43 | ; the end of the fiscal year.
|
|---|
| 44 | ;
|
|---|
| 45 | S OUT=0
|
|---|
| 46 | F D Q:OUT
|
|---|
| 47 | . S MONTHCNT=MONTHCNT+1
|
|---|
| 48 | . D ARAYMO(.LISTI,.LINE,PRSNMDT,MONTHCNT,1,0)
|
|---|
| 49 | . S PRSMO=$E(PRSNMDT,4,5),PRSYR=$E(PRSNMDT,1,3),PRSDY=$E(PRSNMDT,6,7)
|
|---|
| 50 | . S PRSNXTMO=PRSMO+1 I $L(PRSNXTMO)=1 S PRSNXTMO="0"_PRSNXTMO
|
|---|
| 51 | . S PRSNMDT=$S(PRSMO=12:PRSYR+1_"01"_PRSDY,1:PRSYR_PRSNXTMO_"01")
|
|---|
| 52 | . ;if we hit september 30 or october quit
|
|---|
| 53 | . I PRSNXTMO=10!(PRSNMDT>EOFYDT) S OUT=1
|
|---|
| 54 | ;
|
|---|
| 55 | ; Include any weeks in October that are part of the PP
|
|---|
| 56 | ; with September 30, thus the fiscal year spills into october by
|
|---|
| 57 | ; no more than 13 days
|
|---|
| 58 | ;
|
|---|
| 59 | I PRSNXTMO=10&(PRSNMDT'>EOFYDT) D
|
|---|
| 60 | . S MONTHCNT=MONTHCNT+1
|
|---|
| 61 | . D ARAYMO(.LISTI,.LINE,PRSNMDT,MONTHCNT,1,+$E(EOFYDT,6,7))
|
|---|
| 62 | Q
|
|---|
| 63 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 64 | ;
|
|---|
| 65 | ARAYMO(LISTI,LINE,PRSDT,MONTHCNT,STARTDAY,SHORT) ;SILENT CALL TO PLACE MONTH IN ARRAY
|
|---|
| 66 | ; INPUT: PRSDT - must be fileman date
|
|---|
| 67 | ; SHORT - set to # of days to show if a short month
|
|---|
| 68 | ; is desired. i.e. to stop listing after the
|
|---|
| 69 | ; first PP then specify the # of
|
|---|
| 70 | ; days to that date from the 1st of the month
|
|---|
| 71 | ;
|
|---|
| 72 | N X,Y,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,COUNT,HDR
|
|---|
| 73 | S X=PRSDT D ^%DT Q:Y<0
|
|---|
| 74 | S MONTH=$E(PRSDT,4,5),YEAR=$E(PRSDT,1,3)+1700
|
|---|
| 75 | I SHORT D
|
|---|
| 76 | . S DAYS=SHORT
|
|---|
| 77 | E D
|
|---|
| 78 | . S DAYS=$$DAYSINMO(YEAR,MONTH)
|
|---|
| 79 | S FIRSTDAY=$E(PRSDT,1,5)_"01",LASTDAY=$E(PRSDT,1,5)_DAYS
|
|---|
| 80 | ;
|
|---|
| 81 | ;Get day #s of pps in month
|
|---|
| 82 | N PPS
|
|---|
| 83 | I FIRSTDAY<3130000 D GETPPS(FIRSTDAY,LASTDAY)
|
|---|
| 84 | S DAY1=$$WEEKDAY1(PRSDT)
|
|---|
| 85 | S HDR=$$GETHEAD(Y)
|
|---|
| 86 | S LINE=LINE+1
|
|---|
| 87 | S ^TMP("PRSARC",$J,LINE,0)=" ============="_HDR_"============"
|
|---|
| 88 | ;
|
|---|
| 89 | D DISPMO(.LISTI,.LINE,DAY1,DAYS,1,STARTDAY)
|
|---|
| 90 | ;S LINE=LINE+1
|
|---|
| 91 | ;D HOLIDAY
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 95 | DISPMO(LISTI,LINE,DAYNO,NODAYS,SKPW1,STRTDY) ;store a month into an array
|
|---|
| 96 | ;SAMPLE CALL: D DISPMO(4,30,.L,0) Produces a 30 day month with day 1
|
|---|
| 97 | ; beginning on Wednesday.
|
|---|
| 98 | ;SAMPLE CALL: D DISPMO(4,30,.L,1) Produces a 30 day month starting
|
|---|
| 99 | ; in week 2 Sunday--day 5
|
|---|
| 100 | ;
|
|---|
| 101 | ;INPUT:
|
|---|
| 102 | ; DAYNO : integer value of weekday (0=sun,1=mon,2=tues,...,6=sat)
|
|---|
| 103 | ; NODAYS: integer value of days in month, i.e. 30 days has sept...
|
|---|
| 104 | ; SKIPW1: set to true if you want to skip partial 1st week
|
|---|
| 105 | ; STRTDY: set to day of month to start calendar.
|
|---|
| 106 | ;
|
|---|
| 107 | N DAYS,DAYPOS,I,PPOFFSET,CNTDWN,BLNKS,LEADBLNK,WRTAB
|
|---|
| 108 | S PPOFFSET=" ",CNTDWN=NODAYS
|
|---|
| 109 | ;
|
|---|
| 110 | ; keep track of selectable items in the list (LISTI) and
|
|---|
| 111 | ; lines in the list
|
|---|
| 112 | ;
|
|---|
| 113 | ; start with second week when SKPW1 is true and the first week
|
|---|
| 114 | ; of the month isn't a full week.
|
|---|
| 115 | ; also I STARTDAY is > 1 then use it (we only want a partial month)
|
|---|
| 116 | I (STRTDY=1)&SKPW1&(DAYNO'=0) S STRTDY=8-DAYNO
|
|---|
| 117 | F I=STRTDY:1:NODAYS D
|
|---|
| 118 | . S DAYPOS=(DAYNO+I-1)#7
|
|---|
| 119 | . I DAYPOS=0 D
|
|---|
| 120 | .. S LINE=LINE+1
|
|---|
| 121 | .. S LEADBLNK=$E(" ",1,(3-$L(LISTI)))
|
|---|
| 122 | .. S BLNKS=" "
|
|---|
| 123 | .. I $G(PPS(I))'="" D
|
|---|
| 124 | ... ; index of items that are selectable (weeks only, no month heads)
|
|---|
| 125 | ... S ^TMP("PRSLI",$J,LISTI)=LINE
|
|---|
| 126 | ... ; ListManager's items
|
|---|
| 127 | ... S ^TMP("PRSARC",$J,LINE,0)=LEADBLNK_LISTI_BLNKS_PPS(I)
|
|---|
| 128 | .. E D
|
|---|
| 129 | ... S ^TMP("PRSLI",$J,LISTI)=LINE
|
|---|
| 130 | ... S ^TMP("PRSARC",$J,LINE,0)=LEADBLNK_LISTI_BLNKS_PPOFFSET
|
|---|
| 131 | .. S LISTI=LISTI+1
|
|---|
| 132 | . I ($G(CNTDWN)>0) D
|
|---|
| 133 | .. S WRTAB=$S($L(I)=2:" ",1:" ")
|
|---|
| 134 | .. S ^TMP("PRSARC",$J,LINE,0)=$G(^TMP("PRSARC",$J,LINE,0))_WRTAB_I
|
|---|
| 135 | .. S CNTDWN=CNTDWN-1
|
|---|
| 136 | ;
|
|---|
| 137 | ; add first days of next month to the last week
|
|---|
| 138 | ;
|
|---|
| 139 | I DAYPOS'=6 D
|
|---|
| 140 | . F I=1:1:7-(DAYPOS+1) S ^TMP("PRSARC",$J,LINE,0)=$G(^TMP("PRSARC",$J,LINE,0))_" "_I
|
|---|
| 141 | Q
|
|---|
| 142 | ;
|
|---|
| 143 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 144 | ;
|
|---|
| 145 | GETPPS(FIRSTDAY,LASTDAY) ;
|
|---|
| 146 | N D1,PPE,PPDAY,PPI,PP4Y
|
|---|
| 147 | S D1=FIRSTDAY D PP^PRSAPPU
|
|---|
| 148 | D NX^PRSAPPU
|
|---|
| 149 | I D1<FIRSTDAY S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
|
|---|
| 150 | S PPDAY=+$E(D1,6,7)
|
|---|
| 151 | S PPS(PPDAY)=PPE
|
|---|
| 152 | F D Q:D1>LASTDAY
|
|---|
| 153 | . S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
|
|---|
| 154 | . Q:D1>LASTDAY
|
|---|
| 155 | . S PPDAY=+$E(D1,6,7)
|
|---|
| 156 | . S PPS(PPDAY)=PPE
|
|---|
| 157 | Q
|
|---|
| 158 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 159 | ;
|
|---|
| 160 | GETHEAD(Y) ;
|
|---|
| 161 | N YEAR,MONTH,HDR,LENOFDT
|
|---|
| 162 | S HDR=$$FMTE^XLFDT(Y,"1D")
|
|---|
| 163 | S MONTH=$P(HDR," ")
|
|---|
| 164 | S LENOFDT=$L(HDR," ")
|
|---|
| 165 | S YEAR=$P(HDR," ",LENOFDT)
|
|---|
| 166 | Q MONTH_" "_YEAR
|
|---|
| 167 | ;
|
|---|
| 168 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 169 | ;
|
|---|
| 170 | WEEKDAY1(ZDATE) ;get the weekday of the 1st day of the month
|
|---|
| 171 | ; INPUT: ZDATE - FileMan date, used as the month to display
|
|---|
| 172 | ; OUTPUT: return - Integer corresponding to day of week
|
|---|
| 173 | ; (i.e. Sunday[1], Monday[2]) for the 1st day of
|
|---|
| 174 | ; the month
|
|---|
| 175 | S ZDATE=$E(ZDATE,1,5)_"01"
|
|---|
| 176 | Q $$DOW^XLFDT(ZDATE,1)
|
|---|
| 177 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 178 | ;
|
|---|
| 179 | DAYSINMO(Y,M) ; Return # of days in month based on year and month
|
|---|
| 180 | ; Input: Y = year in 4 digit format between 1700 and 3000
|
|---|
| 181 | ; M = month expressed as an integer from 1 to 12 (Jan - Dec)
|
|---|
| 182 | ;
|
|---|
| 183 | N GOODY,GOODM S (GOODY,GOODM)=0
|
|---|
| 184 | I Y<2700,Y>1700 S GOODY=1
|
|---|
| 185 | I M>0,M<13 S GOODM=1
|
|---|
| 186 | Q:'(GOODM&GOODY) 0
|
|---|
| 187 | Q $P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
|
|---|
