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