175 lines
5.7 KiB
Mathematica
175 lines
5.7 KiB
Mathematica
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
|