PRSARC06 ;WOIFO/JAH - Recess Tracking ListManger Inteface ;10/16/06 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54 ;;Per VHA Directive 2004-038, this routine should not be modified. Q MAIN(LSTART,LISTI,LINE,PRSDT,PRSFYRNG) ; BUILD LIST OF CALENDER FROM PP WITH PRSDT ; THROUGH PP CONTAINING SEPTEMBER 30 ; ; PRSNMDT - date for new month ; ; Q:$G(PRSOUT)=1 N FIRSTPP,PRSNMDT,FFPPE,LFPPE,EOFYDT,OUT,PRSDY,PRSMO,PRSNXTMO,PRSYR ; ; Get PP with PRSDT and convert PRSDT to the 1st day of that pp ; S FIRSTPP=$$GETPPDY^PRSARC04(PRSDT) S FFPPE=$P(FIRSTPP,U,2) S (PRSDT,PRSNMDT)=$P(FIRSTPP,U,1) ; ; lookup which week of the fiscal year the schedule begins ; this week # will be the first selectable item in the list ; S (LSTART,LISTI)=$G(FMWKS(PRSDT)) ; ; Get the last PP of the fiscal year and it's last day. S LFPPE=$P(PRSFYRNG,U,4) S EOFYDT=$P(PRSFYRNG,U,2) ; ; if the first week in the AWS schedule is not both the 1st day ; of a PP and the first day of the month, then we need ; special code for that month, so that a partial month is used ; including only the pps that are part of the schedule. ; S (OUT,LINE,MONTHCNT)=0 I $E(PRSDT,6,7)'="01" D . S STARTDAY=$E(PRSDT,6,7) . D ARAYMO(.LISTI,.LINE,PRSDT,MONTHCNT,STARTDAY,0) . S PRSMO=$E(PRSDT,4,5),PRSYR=$E(PRSDT,1,3),PRSDY=$E(PRSDT,6,7) . S PRSNXTMO=PRSMO+1 I $L(PRSNXTMO)=1 S PRSNXTMO="0"_PRSNXTMO . S PRSNMDT=$S(PRSMO=12:PRSYR+1_"01"_PRSDY,1:PRSYR_PRSNXTMO_"01") ; ; loop through the calendar building list items for every week in ; the year until we reach october. All agreements are through ; the end of the fiscal year. ; S OUT=0 F D Q:OUT . S MONTHCNT=MONTHCNT+1 . D ARAYMO(.LISTI,.LINE,PRSNMDT,MONTHCNT,1,0) . S PRSMO=$E(PRSNMDT,4,5),PRSYR=$E(PRSNMDT,1,3),PRSDY=$E(PRSNMDT,6,7) . S PRSNXTMO=PRSMO+1 I $L(PRSNXTMO)=1 S PRSNXTMO="0"_PRSNXTMO . S PRSNMDT=$S(PRSMO=12:PRSYR+1_"01"_PRSDY,1:PRSYR_PRSNXTMO_"01") . ;if we hit september 30 or october quit . I PRSNXTMO=10!(PRSNMDT>EOFYDT) S OUT=1 ; ; Include any weeks in October that are part of the PP ; with September 30, thus the fiscal year spills into october by ; no more than 13 days ; I PRSNXTMO=10&(PRSNMDT'>EOFYDT) D . S MONTHCNT=MONTHCNT+1 . D ARAYMO(.LISTI,.LINE,PRSNMDT,MONTHCNT,1,+$E(EOFYDT,6,7)) Q ;= = = = = = = = = = = = = = = = = = = = = = = = = = = ; ARAYMO(LISTI,LINE,PRSDT,MONTHCNT,STARTDAY,SHORT) ;SILENT CALL TO PLACE MONTH IN ARRAY ; INPUT: PRSDT - must be fileman date ; SHORT - set to # of days to show if a short month ; is desired. i.e. to stop listing after the ; first PP then specify the # of ; days to that date from the 1st of the month ; N X,Y,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,COUNT,HDR S X=PRSDT D ^%DT Q:Y<0 S MONTH=$E(PRSDT,4,5),YEAR=$E(PRSDT,1,3)+1700 I SHORT D . S DAYS=SHORT E D . S DAYS=$$DAYSINMO(YEAR,MONTH) S FIRSTDAY=$E(PRSDT,1,5)_"01",LASTDAY=$E(PRSDT,1,5)_DAYS ; ;Get day #s of pps in month N PPS I FIRSTDAY<3130000 D GETPPS(FIRSTDAY,LASTDAY) S DAY1=$$WEEKDAY1(PRSDT) S HDR=$$GETHEAD(Y) S LINE=LINE+1 S ^TMP("PRSARC",$J,LINE,0)=" ============="_HDR_"============" ; D DISPMO(.LISTI,.LINE,DAY1,DAYS,1,STARTDAY) ;S LINE=LINE+1 ;D HOLIDAY Q ; ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = DISPMO(LISTI,LINE,DAYNO,NODAYS,SKPW1,STRTDY) ;store a month into an array ;SAMPLE CALL: D DISPMO(4,30,.L,0) Produces a 30 day month with day 1 ; beginning on Wednesday. ;SAMPLE CALL: D DISPMO(4,30,.L,1) Produces a 30 day month starting ; in week 2 Sunday--day 5 ; ;INPUT: ; DAYNO : integer value of weekday (0=sun,1=mon,2=tues,...,6=sat) ; NODAYS: integer value of days in month, i.e. 30 days has sept... ; SKIPW1: set to true if you want to skip partial 1st week ; STRTDY: set to day of month to start calendar. ; N DAYS,DAYPOS,I,PPOFFSET,CNTDWN,BLNKS,LEADBLNK,WRTAB S PPOFFSET=" ",CNTDWN=NODAYS ; ; keep track of selectable items in the list (LISTI) and ; lines in the list ; ; start with second week when SKPW1 is true and the first week ; of the month isn't a full week. ; also I STARTDAY is > 1 then use it (we only want a partial month) I (STRTDY=1)&SKPW1&(DAYNO'=0) S STRTDY=8-DAYNO F I=STRTDY:1:NODAYS D . S DAYPOS=(DAYNO+I-1)#7 . I DAYPOS=0 D .. S LINE=LINE+1 .. S LEADBLNK=$E(" ",1,(3-$L(LISTI))) .. S BLNKS=" " .. I $G(PPS(I))'="" D ... ; index of items that are selectable (weeks only, no month heads) ... S ^TMP("PRSLI",$J,LISTI)=LINE ... ; ListManager's items ... S ^TMP("PRSARC",$J,LINE,0)=LEADBLNK_LISTI_BLNKS_PPS(I) .. E D ... S ^TMP("PRSLI",$J,LISTI)=LINE ... S ^TMP("PRSARC",$J,LINE,0)=LEADBLNK_LISTI_BLNKS_PPOFFSET .. S LISTI=LISTI+1 . I ($G(CNTDWN)>0) D .. S WRTAB=$S($L(I)=2:" ",1:" ") .. S ^TMP("PRSARC",$J,LINE,0)=$G(^TMP("PRSARC",$J,LINE,0))_WRTAB_I .. S CNTDWN=CNTDWN-1 ; ; add first days of next month to the last week ; I DAYPOS'=6 D . F I=1:1:7-(DAYPOS+1) S ^TMP("PRSARC",$J,LINE,0)=$G(^TMP("PRSARC",$J,LINE,0))_" "_I Q ; ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ; GETPPS(FIRSTDAY,LASTDAY) ; N D1,PPE,PPDAY,PPI,PP4Y S D1=FIRSTDAY D PP^PRSAPPU D NX^PRSAPPU I D1LASTDAY . S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU . Q:D1>LASTDAY . S PPDAY=+$E(D1,6,7) . S PPS(PPDAY)=PPE Q ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ; GETHEAD(Y) ; N YEAR,MONTH,HDR,LENOFDT S HDR=$$FMTE^XLFDT(Y,"1D") S MONTH=$P(HDR," ") S LENOFDT=$L(HDR," ") S YEAR=$P(HDR," ",LENOFDT) Q MONTH_" "_YEAR ; ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ; WEEKDAY1(ZDATE) ;get the weekday of the 1st day of the month ; INPUT: ZDATE - FileMan date, used as the month to display ; OUTPUT: return - Integer corresponding to day of week ; (i.e. Sunday[1], Monday[2]) for the 1st day of ; the month S ZDATE=$E(ZDATE,1,5)_"01" Q $$DOW^XLFDT(ZDATE,1) ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = ; DAYSINMO(Y,M) ; Return # of days in month based on year and month ; Input: Y = year in 4 digit format between 1700 and 3000 ; M = month expressed as an integer from 1 to 12 (Jan - Dec) ; N GOODY,GOODM S (GOODY,GOODM)=0 I Y<2700,Y>1700 S GOODY=1 I M>0,M<13 S GOODM=1 Q:'(GOODM&GOODY) 0 Q $P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)