PRSARC02 ;WOIFO/JAH - Recess Tracking Library Functions ;10/16/06
 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 Q
GETNURSE(NURSE,PRSTLV) ; procedure prompts and screens only 9-month AWS nurses
 ;   
 ;
 ; INPUT: PRSTLV - flag to indicate T&L access, 2 for timekeeper
 ;                 3 for 
 ; OUTPUT: NURSE (3 ^ pieces)
 ;           1) - Nurse IEN from 450 lookup which is screened for
 ;            (DB part-time + NH 80 + pp M) or (recess rec exists)
 ;           2) Nurse name
 ;           3) 0 edit only, 1 add and edit
 ;
 ; use full screen for initial prompts
 D FULL^VALM1
 W @IOF,!!!
 ;
 ;Ask T&L unit
 ;
 N TLI,TLE,SSN,DUMMY
 I $G(PRSTLV)'>0 Q -1
 D ^PRSAUTL
 I $G(TLE)="" Q -1
 ;
 ;Lookup employees screening on t&l, normal hours, duty basis, pay plan
 ;
 N DIC,D
 S DIC("A")="Select AWS NURSE: "
 S DIC(0)="AEQM"
 S DIC="^PRSPC("
 S D="ATL"_TLE
 S DIC("S")="I $P(^(0),U,8)=TLE,(($P(^(0),U,16)=80)&($P(^(0),U,10)=2)&($P(^(0),U,21)=""M""))!($O(^PRST(458.8,""B"",+Y,0)))"
 D IX^DIC
 S NURSE=Y
 I +NURSE'>0 Q -1
 ;
 ; ensure entitlement string returns recess periods set to 1
 ;
 N DFN,ENT,ZENT
 S DFN=+NURSE
 D ^PRSAENT S ZENT=$S($E(ENT,5):"Recess Periods",1:"")
 I ZENT="" D
 .  W !!?5,"This nurse is not currently entitled to Recess Periods."
 .  W !?5,"A new FY Recess Record cannot be added, but existing FY"
 .  W !?5,"Recess records may be edited."
 .  W ! S DUMMY=$$ASK^PRSLIB00(1)
 .  S NURSE=NURSE_U_0
 E  D
 .  S NURSE=NURSE_U_1
 S SSN=$P(^PRSPC(+NURSE,0),U,9),SSN="XXX-XX-"_$E(SSN,6,9)
 S NURSE=NURSE_U_TLE_U_SSN
 Q
 ;
CHOOSEFY(SELFY,NURSE) ; Build List of FY choices--Last, Current, Next--include
 ; whether a record exists for that fiscal year already or not
 ;
 ;  INPUT: NURSE- IEN^NAME^(0 edit only, 1 add and edit)
 ;         if nurse entitled to recess, new rec can be added, else
 ;         only edit existing records allowed.
 ;  OUTPUT: SELFY-selected fiscal year data (11 ^ piece string)
 ;    1) 4 digit yr           2) ex.FY06-07      3) external 1st day
 ;    4) external last day    5) FM 1st day      6) FM last day
 ;    7) first pp             8) last pp         9) 458.8 IEN if exists 
 ;    10) ext AWS start date 11) FM date AWS start
 ;    12) AWS start pay period
 ;
 ;    example:
 ; 2007^FY06-07^10/01/06^10/13/07^3061001^3071013^06-20^07-20^1
 ; ^11/12/06^3061112^06-23
 ;
 ; entitled to Recess
 N RENT,FYA,FYSA
 S RENT=$P(NURSE,U,3)
 ;
 ; check to see if any Schedules are on file for this Nurse
 ;
 D FIND^DIC(458.8,,".01;1;1.1","Q",+NURSE,"AC",,,,"FYA")
 ;
 ; get current next and last
 ;
 D PRMPTARY
 ;
 ; if there are no editable records in the range and the Nurse
 ; isn't entitled then the gig is up.
 ;
 I 'RENT&($P(FYSA(1),U,9)=""&($P(FYSA(2),U,9)="")&($P(FYSA(3),U,9)="")) D  Q
 .  W !,$P(NURSE,U,2)," has no AWS schedules in the current, next or last fiscal years."
 ;
 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,CHOICE,CH,DIRUT
 S DIR(0)=$$BLDDIR(.FYSA,.CHOICE,RENT)
 S CH=CHOICE
 I $L(CHOICE)=3 S CH=$E(CHOICE,1)_", "_$E(CHOICE,2)_" or "_$E(CHOICE,3)
 E  I $L(CHOICE)=2 S CH=$E(CHOICE,1)_" or "_$E(CHOICE,2)
 S DIR("?")="  Enter "_CH_" to "_$S(RENT:"add or edit",1:"edit")_" the recess schedule for that fiscal year."
 S DIR("?",1)="  Edit a fiscal year by entering the code on the left."
 S DIR("?",2)="  The available choices for editing a 9 month AWS"
 S DIR("?",3)="  recess record are limited to the current, next and last"
 S DIR("?",4)="  fiscal years.  If the nurse has an AWS record on file"
 S DIR("?",5)="  for the current, next or last fiscal year then the"
 S DIR("?",6)="  record may be edited.  To add a new schedule the nurse"
 S DIR("?",7)="  must have a pay plan of M, a duty basis of part-time"
 S DIR("?",8)="  and normal Hours equal to 80."
 S DIR("A")="Select fiscal year"
 S DIR("B")=$E(CHOICE,1)
 D ^DIR
 I $D(DIRUT) S SELFY=0
 E  S SELFY=FYSA($S(Y="C":1,Y="N":2,1:3))
 Q
 ;
PRMPTARY ; Build array w/fiscal year selections to edit
 N FY,CNT,REC,FOUND,ST,EN,RANGE,RWIEN,CUR,CUR4Y,EXTRANGE,PPE,STDT
 N X,TMPDT,EXTSTDT,LAS,LAS4Y,NEX,NEX4Y
 S CUR=$$GETFSCYR^PRSARC04(DT)
 S CUR4Y=+$E(CUR,1,3)
 S TMPDT=CUR4Y+1_"0101"
 S NEX=$$GETFSCYR^PRSARC04(TMPDT)
 S NEX4Y=+$E(NEX,1,3)
 S TMPDT=NEX4Y-2_"0101"
 S LAS=$$GETFSCYR^PRSARC04(TMPDT)
 S LAS4Y=+$E(LAS,1,3)
 S CUR4Y=CUR4Y+1700
 S NEX4Y=NEX4Y+1700
 S LAS4Y=LAS4Y+1700
 ;
 S CNT=0
 F FY=CUR4Y,NEX4Y,LAS4Y D
 .  S CNT=CNT+1
 .  S (REC,FOUND)=0
 .  F  S REC=$O(FYA("DILIST","ID",REC)) Q:REC'>0!(FOUND)  D
 ..   I FYA("DILIST","ID",REC,1)=FY S FOUND=REC,RWIEN=FYA("DILIST",2,REC)
 .  S RANGE=$$FYDAYS^PRSARC04(FY)
 .  S ST=$P(RANGE,U)
 .  S EN=$P(RANGE,U,2)
 .  S ST=$E(ST,4,5)_"/"_$E(ST,6,7)_"/"_$E(ST,2,3)
 .  S EN=$E(EN,4,5)_"/"_$E(EN,6,7)_"/"_$E(EN,2,3)
 .  S EXTRANGE=ST_U_EN
 .  S FYSA(CNT)=$S(CNT=2:NEX4Y,CNT=1:CUR4Y,1:LAS4Y)
 .  S FYSA(CNT)=FYSA(CNT)_U_$P($S(CNT=2:NEX,CNT=1:CUR,1:LAS),U,3)_U_EXTRANGE_U_RANGE
 .  I FOUND D
 ..    ;convert start date to mm/dd/yy
 ..    S X=$G(FYA("DILIST","ID",FOUND,1.1))
 ..    D ^%DT
 ..    S STDT=Y
 ..    N D1 S D1=STDT D PP^PRSAPPU
 ..    S EXTSTDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
 ..    S FYSA(CNT)=FYSA(CNT)_U_RWIEN_U_EXTSTDT_U_STDT_U_PPE
 .  E  D
 ..    S FYSA(CNT)=FYSA(CNT)_U_U_U
 ;
 Q
BLDDIR(FYSA,CHOICES,RENT) ; Put Set of Codes for DIR into DIR(0) format
 I '$D(FYSA) W !,"Error: no fiscal year data!",!! Q
 ;
 N CNT,CI,SOC,AW,SELI,NR
 S CNT=0
 S NR="-has no existing record."
 S AW="-has AWS start date "
 ;
 ; SOC -set of codes
 ;
 N SOC S SOC="",CHOICES=""
 F SELI="Current","Next","Last" D
 . S CNT=CNT+1
 . S CI=$G(FYSA(CNT))
 . Q:RENT=0&($P(CI,U,9)="")
 . S CHOICES=CHOICES_$S(CNT=1:"C",CNT=2:"N",1:"L")
 . I SOC="" D
 ..  S SOC="S^"_$S(CNT=1:"C:",CNT=2:"N:",1:"L:")
 . E  D
 ..  S SOC=SOC_$S(CNT=2:";N:",1:";L:")
 . S SOC=SOC_SELI_" FY"_$P(CI,U,1)_" begins "_$P(CI,U,3)_$S($P(CI,U,9)'="":AW_$P(CI,U,10),1:NR)
 Q SOC