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