PRSARC01 ;WOIFO/JAH - Recess Tracking ListManger Action Protocols ;10/17/06
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
; ^TMP("PRSSW",$J) index of user selected weeks.
; ^TMP("PRSRW",$J) index of recess weeks with hours.
;
EDITSTRT ; action protocol-edit AWS Start Date
;
N RWREC
S VALMBCK="R"
I $G(PRSVIEW) D VWMSG^PRSARC03(1) Q
N OUT
D FULL^VALM1
W @IOF,!
;
W !," WARNING: Changing the AWS start date will remove recess hours"
W !," that are earlier than the new AWS start date.",!
S OUT=$$ASK^PRSLIB00()
S VALMBCK="R"
Q:OUT
N PRSDTTMP
S PRSDTTMP=PRSDT
D NEWSTART^PRSARC03(.OUT,.PRSDT)
I OUT S PRSDT=PRSDTTMP Q
;
S RWREC=$P(PRSFY,U,9)
I RWREC>0 D GETFLWKS^PRSARC03(RWREC,PRSDT)
S PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
N FIRSTRW
S FIRSTRW=$O(^TMP("PRSRW",$J,0))
I $G(FIRSTRW)>0 S FIRSTRW=+^TMP("PRSRW",$J,FIRSTRW)
S VALMBG=$S($G(FIRSTRW)>3:FIRSTRW-1,1:1)
Q
;
SETWKHRS(OUT) ;set hrs for selected weeks
;
N RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH
S VALMBCK="R"
D FULL^VALM1
W @IOF,!
I '$D(^TMP("PRSSW",$J)) D Q
. W !,"No weeks have been selected."
. S OUT=$$ASK^PRSLIB00(1)
. S VALMBCK="R"
;
D WHATHRS(.OUT,.RH1,.RH2,.OTHERHRS,.UOH,.CTRH1,.CTRH2,.UCTH)
I $G(OUT) S VALMBCK="R" Q
;
D SETWKSLM(.OOPSWKS,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH)
;
I $G(OOPSWKS)'="" S VALMSG="No tour data for the following weeks: "_$P(OOPSWKS,1,$L(OOPSWKS,",")-1)
;
D DSELALL
S VALMBCK="R"
Q
WHATHRS(OUT,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH) ;Ask user-which hours
; to use.
;
; UCTH-use current tour hours flag
; get current ToD hrs for week 1,2-ask whether to use hrs for recess.
;
N DIR,Y,I
S (CTRH1,CTRH2,RH1,RH2,OTHERHRS,UOH,UCTH)=0
N PPI S PPI=$O(^PRST(458,999999),-1)
N TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
S CTRH1=TH("W1"),CTRH2=TH("W2")
I CTRH1>0!(CTRH2>0) D
. S UOH=1
. S OTHERHRS=$$OTHERHRS^PRSARC03(CTRH1,CTRH2,+PRSNURSE)
. I OTHERHRS D
.. S DIR("A")="Set recess to match tour hours from the timecard (Recommended)"
.. S DIR("?",1)=" You have selected weeks in the past that have tour hours"
.. S DIR("?",2)=" on the nurses' timecard that are different than the"
.. S DIR("?",3)=" current tour hours."
.. S DIR("?",4)=""
.. S DIR("?",5)="Current tour of duty hours are as follows:"
.. S DIR("?",6)=" Week 1 of pay period: "_TH("W1")
.. S DIR("?",7)=" Week 2 of pay period: "_TH("W2")
.. S I=0 F S I=$O(DIR("?",I)) Q:I'>0 W !,DIR("?",I)
.. S DIR("B")="YES"
.. S DIR(0)="Y"
.. D ^DIR
.. S (UOH,UCTH)=+Y
. I 'OTHERHRS!(UOH=0) D
.. S DIR("A")="Set recess hours to current tour of duty hours"
.. S DIR("?",1)="Current tour of duty hours are as follows:"
.. S DIR("?",2)=" Week 1 of pay period: "_TH("W1")
.. S DIR("?",3)=" Week 2 of pay period: "_TH("W2")
.. S DIR("?",4)=""
.. S DIR("?",5)="Choose yes to mark recess weeks with current tour of duty hours"
.. S DIR("?",6)="for week 1 and 2."
.. S DIR("?")="Enter yes or no."
.. S DIR("B")="YES"
.. S DIR(0)="Y"
.. S I=0 F S I=$O(DIR("?",I)) Q:I'>0 W !,DIR("?",I)
.. D ^DIR
.. S UCTH=Y
E D
. W !,"There are no tour hours in the current pay period."
. S UCTH=0
;
I $D(DIRUT) Q
;
N ODD,EVEN
I 'UCTH D
. ; return true if there are odd or even pp weeks in the selection
. D EVEODDWK^PRSARC03(.ODD,.EVEN)
. I ODD D
.. K DIR,Y
.. S DIR("B")=40
.. S DIR("A")="Enter recess hours for the 1st week of the pay period"
.. S DIR("?")="Pay period week 1 hours. Enter the recess hours for selected weeks."
.. S DIR(0)="N^0:72:2"
.. N VALID S (VALID,OUT)=0
.. F D Q:VALID!OUT
... D ^DIR
... I (+Y#.25)=0 S VALID=1
... I +Y=0 S Y=""
... I $D(DIRUT) S OUT=1
... S RH1=Y
. Q:$G(OUT)
. I EVEN D
.. K DIR,Y
.. S DIR("B")=80-$S($G(RH1)>0:RH1,1:40)
.. S DIR("A")="Enter recess hours for the 2nd week of the pay period"
.. S DIR("?")="Pay period week 2 hours. Enter the recess hours for selected weeks."
.. S DIR(0)="N^0:72:2"
.. N VALID S (VALID,OUT)=0
.. F D Q:VALID!OUT
... D ^DIR
... I (+Y#.25)=0 S VALID=1
... I +Y=0 S Y=""
... I $D(DIRUT) S OUT=1
... S RH2=Y
Q
SETWKSLM(OOPSWKS,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH) ;
; Set weeks RECESS HOURS in listmanager display
;
N ITEM,LSTITEM
N OOPSWKS S OOPSWKS=""
S ITEM=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0 D
. ; Get item out of selectable items index
. S RH=$S(ITEM#2:$G(RH1),1:$G(RH2))
. I $G(OTHERHRS),$G(UOH) D
.. N D1,DAY,PPI,PPE S D1=$G(WKSFM(ITEM)) D PP^PRSAPPU
.. I $G(PPI)>0 D
... K TH D TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
... S RH=$S(ITEM#2:TH("W1"),1:TH("W2"))
. I RH'>0,UCTH S RH=$S(ITEM#2:CTRH1,1:CTRH2)
. S LSTITEM=$G(^TMP("PRSSW",$J,ITEM))
. D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$J(RH,15,2))
.;
.; set hours for selected weeks, remove from array if 0
.;
. I RH'>0 D
.. I UCTH S OOPSWKS=OOPSWKS_ITEM_","
.. K ^TMP("PRSRW",$J,ITEM)
. E D
.. S $P(^TMP("PRSRW",$J,ITEM),U,2)=RH
.. S $P(^TMP("PRSRW",$J,ITEM),U,3)=$G(WKSFM(ITEM))
.. ;S $P(^TMP("PRSRW",$J,ITEM),U,4)=REW
Q
SELRWK(PR,OUT) ;PROMPT USER TO SELECT WEEKS FOR RECESS
;
; INPUT: PR-prompt flag are they setting recess hours or removing
; recess hours
; OUTPUT: OUT - user aborted or timed out
S VALMBCK="R"
I $G(PRSVIEW) D VWMSG^PRSARC03(1) Q
N DIR,DIRUT,LISTI,ITEM,Y
S OUT=1
;
; clear out current selections
;
D DSELALL
N PRESEL
S PRESEL=+$P($P($G(XQORNOD(0)),U,4),"=",2)
I PRESEL,(PRESEL'=$P($P($G(XQORNOD(0)),U,4),"=",2))!((PRESEL'>PRSWKLST)&(PRESEL'<PRSLSTRT)) S Y=$$PARSE^PRSARC08(XQORNOD(0),PRSLSTRT,PRSWKLST)
I '(+$G(Y))!(+$G(Y)<PRSLSTRT)!(+$G(Y)>PRSWKLST) D
.S DIR(0)="L^"_PRSLSTRT_":"_PRSWKLST
.I $G(PR)="Z" D
.. S DIR("A")="Enter week numbers to set back to work weeks"
.E D
.. S DIR("A")="Enter week numbers to set to recess"
.;
.D ^DIR
S VALMBCK="R"
Q:$D(DIRUT)
F I=1:1:$L(Y,",") D
. S ITEM=+$P(Y,",",I)
. Q:ITEM'>0
. ; Get item out of selectable items index
. S LISTI=$G(^TMP("PRSLI",$J,ITEM))
.;
.; set selection week, recess
.;
. S $P(^TMP("PRSRW",$J,ITEM),U)=LISTI
. S ^TMP("PRSSW",$J,ITEM)=LISTI
S OUT=0
I "ZX"'[PR D SETWKHRS(.OUT)
S VALMBCK="R"
Q
FLRECESS ; save recess schedule hrs to file
S VALMBCK="Q"
N SURE S SURE=0
;
N CANADD,HASREC,OUT,CHANGE
S CANADD=$P(PRSNURSE,U,3)
S HASREC=$P(PRSFY,U,9)
;
N DIR,Y,DIRUT
I $G(PRSOUT)=1 D
. S CHANGE=$$CHANGE^PRSARC03(HASREC)
. I 'HASREC!CHANGE D
.. S SURE=1
.. S DIR("A")="Changes will be lost. Are you sure you want to quit"
.. S DIR(0)="Y",DIR("B")="NO" D ^DIR
I SURE,(Y=0!$D(DIRUT)) S VALMBCK="R",PRSOUT=0 Q
I $G(PRSOUT)=1 S VALMBCK="Q" D:CHANGE VWMSG^PRSARC03(2) Q
;
;If new record add it. Nurse must be current AWS 9-month
;
N PRSFDA,IEN,IENS,HOURS,WEEK
D FULL^VALM1
;
I CANADD,'HASREC D
. K PRSFDA
. S PRSFDA(458.8,"+1,",.01)=+PRSNURSE
. S PRSFDA(458.8,"+1,",1)=+PRSFY
. S PRSFDA(458.8,"+1,",1.1)=PRSDT
. D UPDATE^DIE("","PRSFDA","IEN"),MSG^DIALOG()
. S HASREC=$G(IEN(1))
. S $P(PRSFY,U,9)=HASREC
. S $P(PRSFY,U,10)=$E(PRSDT,4,5)_"/"_$E(PRSDT,6,7)_"/"_$E(PRSDT,2,3)
. S $P(PRSFY,U,11)=PRSDT
;
I HASREC D
.; start date changed?
. I $P($G(^PRST(458.8,HASREC,3)),U,2)'=PRSDT D
.. K PRSFDA,IENS
.. S IENS=HASREC_","
.. S PRSFDA(458.8,IENS,1.1)=PRSDT
.. D UPDATE^DIE("","PRSFDA","IEN"),MSG^DIALOG()
.. S $P(PRSFY,U,10)=$E(PRSDT,4,5)_"/"_$E(PRSDT,6,7)_"/"_$E(PRSDT,2,3)
.. S $P(PRSFY,U,11)=PRSDT
. I $$CHANGE^PRSARC03(HASREC) D
.. ; clean out old recess week records
.. N WKIEN S WKIEN=0
.. F S WKIEN=$O(^PRST(458.8,HASREC,1,WKIEN)) Q:WKIEN'>0 D
... S IENS=WKIEN_","_HASREC_","
... S PRSFDA(458.82,IENS,.01)="@"
.. D FILE^DIE("E","PRSFDA")
..;
.. S WEEK=0
.. F S WEEK=$O(^TMP("PRSRW",$J,WEEK)) Q:WEEK'>0 D
... S HOURS=$P(^TMP("PRSRW",$J,WEEK),U,2)
... Q:HOURS'>0
... K PRSFDA,IENS
... S IENS="+1,"_HASREC_","
... S PRSFDA(458.82,IENS,.01)=WEEK
... S PRSFDA(458.82,IENS,1)=HOURS
... S PRSFDA(458.82,IENS,2)=$G(WKSFM(WEEK))
... S PRSFDA(458.82,IENS,3)=$P(^TMP("PRSRW",$J,WEEK),U,4)
... D UPDATE^DIE("","PRSFDA","IENS"),MSG^DIALOG()
..;
..; update user edit date time
..;
.. N %,%H,%I,X D NOW^%DTC
.. K PRSFDA,IENS
.. S IENS="+1,"_HASREC_","
.. S PRSFDA(458.83,IENS,.01)=%
.. S PRSFDA(458.83,IENS,1)=DUZ
.. D UPDATE^DIE("","PRSFDA","IENS"),MSG^DIALOG()
. S VALMSG="Changes Saved."
. E D
.. S VALMSG="Recess schedule has not changed since last save."
;
I '$G(PRSVONLY) D
. W !,VALMSG
. S VALMBCK="Q"
E D
. S VALMBCK="R"
Q
;
DSELWK ;DESELECT WEEKS
;
S VALMBCK="R"
I $G(PRSVIEW) D VWMSG^PRSARC03(1) Q
N OUT,ITEM,REW,RH,RDATA
S VALMBCK="R"
D SELRWK("Z",.OUT)
Q:OUT
;
; remove selections from recess array
S (ITEM,RH)=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0 D
. S LSTITEM=$G(^TMP("PRSSW",$J,ITEM))
. D FLDTEXT^VALM10(LSTITEM,"RECESS HOURS","")
. S RDATA=^TMP("PRSRW",$J,ITEM)
. I $P(RDATA,U,5)'>0 D
.. K ^TMP("PRSRW",$J,ITEM)
. E D
.. S $P(^TMP("PRSRW",$J,ITEM),U,2)=""
;
D DSELALL
S VALMBCK="R"
Q
DSELALL ; procedure removes items from selected items index w/no effect
; on ListMan display.
;
N ITEM,LISTI
S ITEM=0
F S ITEM=$O(^TMP("PRSSW",$J,ITEM)) Q:ITEM'>0 D
. S LISTI=$G(^TMP("PRSSW",$J,ITEM))
. K ^TMP("PRSSW",$J,ITEM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC01 9776 printed Apr 09, 2024@21:29:37 Page 2
PRSARC01 ;WOIFO/JAH - Recess Tracking ListManger Action Protocols ;10/17/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
+4 ; ^TMP("PRSSW",$J) index of user selected weeks.
+5 ; ^TMP("PRSRW",$J) index of recess weeks with hours.
+6 ;
EDITSTRT ; action protocol-edit AWS Start Date
+1 ;
+2 NEW RWREC
+3 SET VALMBCK="R"
+4 IF $GET(PRSVIEW)
DO VWMSG^PRSARC03(1)
QUIT
+5 NEW OUT
+6 DO FULL^VALM1
+7 WRITE @IOF,!
+8 ;
+9 WRITE !," WARNING: Changing the AWS start date will remove recess hours"
+10 WRITE !," that are earlier than the new AWS start date.",!
+11 SET OUT=$$ASK^PRSLIB00()
+12 SET VALMBCK="R"
+13 if OUT
QUIT
+14 NEW PRSDTTMP
+15 SET PRSDTTMP=PRSDT
+16 DO NEWSTART^PRSARC03(.OUT,.PRSDT)
+17 IF OUT
SET PRSDT=PRSDTTMP
QUIT
+18 ;
+19 SET RWREC=$PIECE(PRSFY,U,9)
+20 IF RWREC>0
DO GETFLWKS^PRSARC03(RWREC,PRSDT)
+21 SET PRSRWHRS=$$GETAVHRS^PRSARC04(.FMWKS,PRSDT)
+22 NEW FIRSTRW
+23 SET FIRSTRW=$ORDER(^TMP("PRSRW",$JOB,0))
+24 IF $GET(FIRSTRW)>0
SET FIRSTRW=+^TMP("PRSRW",$JOB,FIRSTRW)
+25 SET VALMBG=$SELECT($GET(FIRSTRW)>3:FIRSTRW-1,1:1)
+26 QUIT
+27 ;
SETWKHRS(OUT) ;set hrs for selected weeks
+1 ;
+2 NEW RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH
+3 SET VALMBCK="R"
+4 DO FULL^VALM1
+5 WRITE @IOF,!
+6 IF '$DATA(^TMP("PRSSW",$JOB))
Begin DoDot:1
+7 WRITE !,"No weeks have been selected."
+8 SET OUT=$$ASK^PRSLIB00(1)
+9 SET VALMBCK="R"
End DoDot:1
QUIT
+10 ;
+11 DO WHATHRS(.OUT,.RH1,.RH2,.OTHERHRS,.UOH,.CTRH1,.CTRH2,.UCTH)
+12 IF $GET(OUT)
SET VALMBCK="R"
QUIT
+13 ;
+14 DO SETWKSLM(.OOPSWKS,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH)
+15 ;
+16 IF $GET(OOPSWKS)'=""
SET VALMSG="No tour data for the following weeks: "_$PIECE(OOPSWKS,1,$LENGTH(OOPSWKS,",")-1)
+17 ;
+18 DO DSELALL
+19 SET VALMBCK="R"
+20 QUIT
WHATHRS(OUT,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH) ;Ask user-which hours
+1 ; to use.
+2 ;
+3 ; UCTH-use current tour hours flag
+4 ; get current ToD hrs for week 1,2-ask whether to use hrs for recess.
+5 ;
+6 NEW DIR,Y,I
+7 SET (CTRH1,CTRH2,RH1,RH2,OTHERHRS,UOH,UCTH)=0
+8 NEW PPI
SET PPI=$ORDER(^PRST(458,999999),-1)
+9 NEW TH
DO TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
+10 SET CTRH1=TH("W1")
SET CTRH2=TH("W2")
+11 IF CTRH1>0!(CTRH2>0)
Begin DoDot:1
+12 SET UOH=1
+13 SET OTHERHRS=$$OTHERHRS^PRSARC03(CTRH1,CTRH2,+PRSNURSE)
+14 IF OTHERHRS
Begin DoDot:2
+15 SET DIR("A")="Set recess to match tour hours from the timecard (Recommended)"
+16 SET DIR("?",1)=" You have selected weeks in the past that have tour hours"
+17 SET DIR("?",2)=" on the nurses' timecard that are different than the"
+18 SET DIR("?",3)=" current tour hours."
+19 SET DIR("?",4)=""
+20 SET DIR("?",5)="Current tour of duty hours are as follows:"
+21 SET DIR("?",6)=" Week 1 of pay period: "_TH("W1")
+22 SET DIR("?",7)=" Week 2 of pay period: "_TH("W2")
+23 SET I=0
FOR
SET I=$ORDER(DIR("?",I))
if I'>0
QUIT
WRITE !,DIR("?",I)
+24 SET DIR("B")="YES"
+25 SET DIR(0)="Y"
+26 DO ^DIR
+27 SET (UOH,UCTH)=+Y
End DoDot:2
+28 IF 'OTHERHRS!(UOH=0)
Begin DoDot:2
+29 SET DIR("A")="Set recess hours to current tour of duty hours"
+30 SET DIR("?",1)="Current tour of duty hours are as follows:"
+31 SET DIR("?",2)=" Week 1 of pay period: "_TH("W1")
+32 SET DIR("?",3)=" Week 2 of pay period: "_TH("W2")
+33 SET DIR("?",4)=""
+34 SET DIR("?",5)="Choose yes to mark recess weeks with current tour of duty hours"
+35 SET DIR("?",6)="for week 1 and 2."
+36 SET DIR("?")="Enter yes or no."
+37 SET DIR("B")="YES"
+38 SET DIR(0)="Y"
+39 SET I=0
FOR
SET I=$ORDER(DIR("?",I))
if I'>0
QUIT
WRITE !,DIR("?",I)
+40 DO ^DIR
+41 SET UCTH=Y
End DoDot:2
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 WRITE !,"There are no tour hours in the current pay period."
+44 SET UCTH=0
End DoDot:1
+45 ;
+46 IF $DATA(DIRUT)
QUIT
+47 ;
+48 NEW ODD,EVEN
+49 IF 'UCTH
Begin DoDot:1
+50 ; return true if there are odd or even pp weeks in the selection
+51 DO EVEODDWK^PRSARC03(.ODD,.EVEN)
+52 IF ODD
Begin DoDot:2
+53 KILL DIR,Y
+54 SET DIR("B")=40
+55 SET DIR("A")="Enter recess hours for the 1st week of the pay period"
+56 SET DIR("?")="Pay period week 1 hours. Enter the recess hours for selected weeks."
+57 SET DIR(0)="N^0:72:2"
+58 NEW VALID
SET (VALID,OUT)=0
+59 FOR
Begin DoDot:3
+60 DO ^DIR
+61 IF (+Y#.25)=0
SET VALID=1
+62 IF +Y=0
SET Y=""
+63 IF $DATA(DIRUT)
SET OUT=1
+64 SET RH1=Y
End DoDot:3
if VALID!OUT
QUIT
End DoDot:2
+65 if $GET(OUT)
QUIT
+66 IF EVEN
Begin DoDot:2
+67 KILL DIR,Y
+68 SET DIR("B")=80-$SELECT($GET(RH1)>0:RH1,1:40)
+69 SET DIR("A")="Enter recess hours for the 2nd week of the pay period"
+70 SET DIR("?")="Pay period week 2 hours. Enter the recess hours for selected weeks."
+71 SET DIR(0)="N^0:72:2"
+72 NEW VALID
SET (VALID,OUT)=0
+73 FOR
Begin DoDot:3
+74 DO ^DIR
+75 IF (+Y#.25)=0
SET VALID=1
+76 IF +Y=0
SET Y=""
+77 IF $DATA(DIRUT)
SET OUT=1
+78 SET RH2=Y
End DoDot:3
if VALID!OUT
QUIT
End DoDot:2
End DoDot:1
+79 QUIT
SETWKSLM(OOPSWKS,RH1,RH2,OTHERHRS,UOH,CTRH1,CTRH2,UCTH) ;
+1 ; Set weeks RECESS HOURS in listmanager display
+2 ;
+3 NEW ITEM,LSTITEM
+4 NEW OOPSWKS
SET OOPSWKS=""
+5 SET ITEM=0
+6 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+7 ; Get item out of selectable items index
+8 SET RH=$SELECT(ITEM#2:$GET(RH1),1:$GET(RH2))
+9 IF $GET(OTHERHRS)
IF $GET(UOH)
Begin DoDot:2
+10 NEW D1,DAY,PPI,PPE
SET D1=$GET(WKSFM(ITEM))
DO PP^PRSAPPU
+11 IF $GET(PPI)>0
Begin DoDot:3
+12 KILL TH
DO TOURHRS^PRSARC07(.TH,PPI,+PRSNURSE,"")
+13 SET RH=$SELECT(ITEM#2:TH("W1"),1:TH("W2"))
End DoDot:3
End DoDot:2
+14 IF RH'>0
IF UCTH
SET RH=$SELECT(ITEM#2:CTRH1,1:CTRH2)
+15 SET LSTITEM=$GET(^TMP("PRSSW",$JOB,ITEM))
+16 DO FLDTEXT^VALM10(LSTITEM,"RECESS HOURS",$JUSTIFY(RH,15,2))
+17 ;
+18 ; set hours for selected weeks, remove from array if 0
+19 ;
+20 IF RH'>0
Begin DoDot:2
+21 IF UCTH
SET OOPSWKS=OOPSWKS_ITEM_","
+22 KILL ^TMP("PRSRW",$JOB,ITEM)
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,2)=RH
+25 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,3)=$GET(WKSFM(ITEM))
+26 ;S $P(^TMP("PRSRW",$J,ITEM),U,4)=REW
End DoDot:2
End DoDot:1
+27 QUIT
SELRWK(PR,OUT) ;PROMPT USER TO SELECT WEEKS FOR RECESS
+1 ;
+2 ; INPUT: PR-prompt flag are they setting recess hours or removing
+3 ; recess hours
+4 ; OUTPUT: OUT - user aborted or timed out
+5 SET VALMBCK="R"
+6 IF $GET(PRSVIEW)
DO VWMSG^PRSARC03(1)
QUIT
+7 NEW DIR,DIRUT,LISTI,ITEM,Y
+8 SET OUT=1
+9 ;
+10 ; clear out current selections
+11 ;
+12 DO DSELALL
+13 NEW PRESEL
+14 SET PRESEL=+$PIECE($PIECE($GET(XQORNOD(0)),U,4),"=",2)
+15 IF PRESEL
IF (PRESEL'=$PIECE($PIECE($GET(XQORNOD(0)),U,4),"=",2))!((PRESEL'>PRSWKLST)&(PRESEL'<PRSLSTRT))
SET Y=$$PARSE^PRSARC08(XQORNOD(0),PRSLSTRT,PRSWKLST)
+16 IF '(+$GET(Y))!(+$GET(Y)<PRSLSTRT)!(+$GET(Y)>PRSWKLST)
Begin DoDot:1
+17 SET DIR(0)="L^"_PRSLSTRT_":"_PRSWKLST
+18 IF $GET(PR)="Z"
Begin DoDot:2
+19 SET DIR("A")="Enter week numbers to set back to work weeks"
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 SET DIR("A")="Enter week numbers to set to recess"
End DoDot:2
+22 ;
+23 DO ^DIR
End DoDot:1
+24 SET VALMBCK="R"
+25 if $DATA(DIRUT)
QUIT
+26 FOR I=1:1:$LENGTH(Y,",")
Begin DoDot:1
+27 SET ITEM=+$PIECE(Y,",",I)
+28 if ITEM'>0
QUIT
+29 ; Get item out of selectable items index
+30 SET LISTI=$GET(^TMP("PRSLI",$JOB,ITEM))
+31 ;
+32 ; set selection week, recess
+33 ;
+34 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U)=LISTI
+35 SET ^TMP("PRSSW",$JOB,ITEM)=LISTI
End DoDot:1
+36 SET OUT=0
+37 IF "ZX"'[PR
DO SETWKHRS(.OUT)
+38 SET VALMBCK="R"
+39 QUIT
FLRECESS ; save recess schedule hrs to file
+1 SET VALMBCK="Q"
+2 NEW SURE
SET SURE=0
+3 ;
+4 NEW CANADD,HASREC,OUT,CHANGE
+5 SET CANADD=$PIECE(PRSNURSE,U,3)
+6 SET HASREC=$PIECE(PRSFY,U,9)
+7 ;
+8 NEW DIR,Y,DIRUT
+9 IF $GET(PRSOUT)=1
Begin DoDot:1
+10 SET CHANGE=$$CHANGE^PRSARC03(HASREC)
+11 IF 'HASREC!CHANGE
Begin DoDot:2
+12 SET SURE=1
+13 SET DIR("A")="Changes will be lost. Are you sure you want to quit"
+14 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
End DoDot:2
End DoDot:1
+15 IF SURE
IF (Y=0!$DATA(DIRUT))
SET VALMBCK="R"
SET PRSOUT=0
QUIT
+16 IF $GET(PRSOUT)=1
SET VALMBCK="Q"
if CHANGE
DO VWMSG^PRSARC03(2)
QUIT
+17 ;
+18 ;If new record add it. Nurse must be current AWS 9-month
+19 ;
+20 NEW PRSFDA,IEN,IENS,HOURS,WEEK
+21 DO FULL^VALM1
+22 ;
+23 IF CANADD
IF 'HASREC
Begin DoDot:1
+24 KILL PRSFDA
+25 SET PRSFDA(458.8,"+1,",.01)=+PRSNURSE
+26 SET PRSFDA(458.8,"+1,",1)=+PRSFY
+27 SET PRSFDA(458.8,"+1,",1.1)=PRSDT
+28 DO UPDATE^DIE("","PRSFDA","IEN")
DO MSG^DIALOG()
+29 SET HASREC=$GET(IEN(1))
+30 SET $PIECE(PRSFY,U,9)=HASREC
+31 SET $PIECE(PRSFY,U,10)=$EXTRACT(PRSDT,4,5)_"/"_$EXTRACT(PRSDT,6,7)_"/"_$EXTRACT(PRSDT,2,3)
+32 SET $PIECE(PRSFY,U,11)=PRSDT
End DoDot:1
+33 ;
+34 IF HASREC
Begin DoDot:1
+35 ; start date changed?
+36 IF $PIECE($GET(^PRST(458.8,HASREC,3)),U,2)'=PRSDT
Begin DoDot:2
+37 KILL PRSFDA,IENS
+38 SET IENS=HASREC_","
+39 SET PRSFDA(458.8,IENS,1.1)=PRSDT
+40 DO UPDATE^DIE("","PRSFDA","IEN")
DO MSG^DIALOG()
+41 SET $PIECE(PRSFY,U,10)=$EXTRACT(PRSDT,4,5)_"/"_$EXTRACT(PRSDT,6,7)_"/"_$EXTRACT(PRSDT,2,3)
+42 SET $PIECE(PRSFY,U,11)=PRSDT
End DoDot:2
+43 IF $$CHANGE^PRSARC03(HASREC)
Begin DoDot:2
+44 ; clean out old recess week records
+45 NEW WKIEN
SET WKIEN=0
+46 FOR
SET WKIEN=$ORDER(^PRST(458.8,HASREC,1,WKIEN))
if WKIEN'>0
QUIT
Begin DoDot:3
+47 SET IENS=WKIEN_","_HASREC_","
+48 SET PRSFDA(458.82,IENS,.01)="@"
End DoDot:3
+49 DO FILE^DIE("E","PRSFDA")
+50 ;
+51 SET WEEK=0
+52 FOR
SET WEEK=$ORDER(^TMP("PRSRW",$JOB,WEEK))
if WEEK'>0
QUIT
Begin DoDot:3
+53 SET HOURS=$PIECE(^TMP("PRSRW",$JOB,WEEK),U,2)
+54 if HOURS'>0
QUIT
+55 KILL PRSFDA,IENS
+56 SET IENS="+1,"_HASREC_","
+57 SET PRSFDA(458.82,IENS,.01)=WEEK
+58 SET PRSFDA(458.82,IENS,1)=HOURS
+59 SET PRSFDA(458.82,IENS,2)=$GET(WKSFM(WEEK))
+60 SET PRSFDA(458.82,IENS,3)=$PIECE(^TMP("PRSRW",$JOB,WEEK),U,4)
+61 DO UPDATE^DIE("","PRSFDA","IENS")
DO MSG^DIALOG()
End DoDot:3
+62 ;
+63 ; update user edit date time
+64 ;
+65 NEW %,%H,%I,X
DO NOW^%DTC
+66 KILL PRSFDA,IENS
+67 SET IENS="+1,"_HASREC_","
+68 SET PRSFDA(458.83,IENS,.01)=%
+69 SET PRSFDA(458.83,IENS,1)=DUZ
+70 DO UPDATE^DIE("","PRSFDA","IENS")
DO MSG^DIALOG()
End DoDot:2
+71 SET VALMSG="Changes Saved."
+72 IF '$TEST
Begin DoDot:2
+73 SET VALMSG="Recess schedule has not changed since last save."
End DoDot:2
End DoDot:1
+74 ;
+75 IF '$GET(PRSVONLY)
Begin DoDot:1
+76 WRITE !,VALMSG
+77 SET VALMBCK="Q"
End DoDot:1
+78 IF '$TEST
Begin DoDot:1
+79 SET VALMBCK="R"
End DoDot:1
+80 QUIT
+81 ;
DSELWK ;DESELECT WEEKS
+1 ;
+2 SET VALMBCK="R"
+3 IF $GET(PRSVIEW)
DO VWMSG^PRSARC03(1)
QUIT
+4 NEW OUT,ITEM,REW,RH,RDATA
+5 SET VALMBCK="R"
+6 DO SELRWK("Z",.OUT)
+7 if OUT
QUIT
+8 ;
+9 ; remove selections from recess array
+10 SET (ITEM,RH)=0
+11 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+12 SET LSTITEM=$GET(^TMP("PRSSW",$JOB,ITEM))
+13 DO FLDTEXT^VALM10(LSTITEM,"RECESS HOURS","")
+14 SET RDATA=^TMP("PRSRW",$JOB,ITEM)
+15 IF $PIECE(RDATA,U,5)'>0
Begin DoDot:2
+16 KILL ^TMP("PRSRW",$JOB,ITEM)
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET $PIECE(^TMP("PRSRW",$JOB,ITEM),U,2)=""
End DoDot:2
End DoDot:1
+19 ;
+20 DO DSELALL
+21 SET VALMBCK="R"
+22 QUIT
DSELALL ; procedure removes items from selected items index w/no effect
+1 ; on ListMan display.
+2 ;
+3 NEW ITEM,LISTI
+4 SET ITEM=0
+5 FOR
SET ITEM=$ORDER(^TMP("PRSSW",$JOB,ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+6 SET LISTI=$GET(^TMP("PRSSW",$JOB,ITEM))
+7 KILL ^TMP("PRSSW",$JOB,ITEM)
End DoDot:1
+8 QUIT
