PRSNCR1 ;WOIFO/DAM - Return Approved POC Record;10/28/09
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
Q
RETPOC ; called from option Return Approved Nurse POC Daily Time Record
N GROUP,PRSIEN,VALUE,CANRET
D PIKGROUP^PRSNUT04(.GROUP,"",0)
; quit if any error during group selection
I $P($G(GROUP(0)),U,2)="E" W !!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
S VALUE=+GROUP($O(GROUP(0)))
Q:VALUE'>0
;
; Select Nurse
;
S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
Q:+PRSIEN'>0
;
; Allow user to select a date and reprompt if record is not valid
; for return
;
N %DT,Y,X,OUT
S (CANRET,OUT)=0
S %DT="A"
F D Q:CANRET!OUT
. D ^%DT
. I $G(X)[U!($G(X)="")!(Y'>0) S OUT=1 Q
. S PRSDT=Y
. S PRSDTDAT=$G(^PRST(458,"AD",PRSDT))
. S PPI=$P(PRSDTDAT,U),PRSD=$P(PRSDTDAT,U,2)
. I (PRSD'>0)!(PPI'>0) W " ?? ",$C(7),"ETA Timecard record does not exist for that date." Q
. S CANRET=$$CANRET(PRSIEN,PRSDT,PRSD,PPI)
. I 'CANRET W " ?? ",$C(7),$P(CANRET,U,3)
Q:OUT!('CANRET)
;
D POCDSPLY^PRSNRUT0(PRSIEN,PRSDT,PRSDT)
;
; Confirm that the user does want to return the record
;
N DIR,X,Y,DIRUT
S DIR(0)="Y"
S DIR("B")="YES"
S DIR("A",1)="Are you sure you want to return this Nurse's"
S DIR("A")=$S($P(CANRET,U,2)="R":"daily record",1:"entire pay period")_" for editing"
S DIR("?")="Accept the default YES or enter NO"
D ^DIR
Q:$D(DIRUT)!'$G(Y)
;
; Lookup Record
;
; Confirm return or display a status message that record can't be returned.
; Display Record on that date?
;
; if pp status is R then it must be a return of a daily correction
; otherwise we return the whole pay period.
;
I $P(CANRET,U,2)="R" D
. D UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","E")
. W !,"POC daily record successfully returned."
E D
. D UPDTPOC^PRSNCGR1(PPI,PRSIEN,"E",1)
. W !,"POC pay period successfully returned."
;
Q
;
CANRET(PRSIEN,PRSDT,PRSD,PPI) ; Return true if the record on the specified date
; is allowed to be deleted, otherwise return an error message.
;
N CANRET,PRSDTDAT,PDAYSTAT,PPSTAT
S CANRET=0
;
;
; check does record exist
;
I '+$G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)) D Q CANRET
. S CANRET="0^^POC record does not exist for that date."
;
; if pay period status is only (A)pproved then this pay
; pay period record has never been released and can be
; returned
;
S PPSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,0)),U,2)
I PPSTAT="A" S CANRET="1"_U_PPSTAT_U Q CANRET
;
I PPSTAT="E" D Q CANRET
. S CANRET="0"_U_PPSTAT_U_"POC record status is Entered. It does not need to be returned. It is currently available for editing."
;
; If pay period status is released we need to check the status
; of individual days to determine if Coordinator can return
;
S PDAYSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
;
I PDAYSTAT="" D Q CANRET
. S CANRET="0"_U_PPSTAT_U_"Record does not need to be returned. It is currently available for editing."
;
; status A can be returned, otherwise it's Entered or Released
; and can already be edited or deleted or approved.
;
I PDAYSTAT="A" D
. S CANRET="1"_U_PPSTAT_U
E D
. S CANRET="0"_U_PPSTAT_U_"POC record status is "_$S(PDAYSTAT="E":"Entered",1:"Released")_". It is currently available for editing."
;
;
Q CANRET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNCR1 3427 printed Nov 22, 2024@17:37:12 Page 2
PRSNCR1 ;WOIFO/DAM - Return Approved POC Record;10/28/09
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
RETPOC ; called from option Return Approved Nurse POC Daily Time Record
+1 NEW GROUP,PRSIEN,VALUE,CANRET
+2 DO PIKGROUP^PRSNUT04(.GROUP,"",0)
+3 ; quit if any error during group selection
+4 IF $PIECE($GET(GROUP(0)),U,2)="E"
WRITE !!,?4,$PIECE(GROUP(0),U,3)
SET X=$$ASK^PRSLIB00(1)
QUIT
+5 SET VALUE=+GROUP($ORDER(GROUP(0)))
+6 if VALUE'>0
QUIT
+7 ;
+8 ; Select Nurse
+9 ;
+10 SET PRSIEN=+$$PICKNURS^PRSNUT03($PIECE(GROUP(0),U,2),VALUE)
+11 if +PRSIEN'>0
QUIT
+12 ;
+13 ; Allow user to select a date and reprompt if record is not valid
+14 ; for return
+15 ;
+16 NEW %DT,Y,X,OUT
+17 SET (CANRET,OUT)=0
+18 SET %DT="A"
+19 FOR
Begin DoDot:1
+20 DO ^%DT
+21 IF $GET(X)[U!($GET(X)="")!(Y'>0)
SET OUT=1
QUIT
+22 SET PRSDT=Y
+23 SET PRSDTDAT=$GET(^PRST(458,"AD",PRSDT))
+24 SET PPI=$PIECE(PRSDTDAT,U)
SET PRSD=$PIECE(PRSDTDAT,U,2)
+25 IF (PRSD'>0)!(PPI'>0)
WRITE " ?? ",$CHAR(7),"ETA Timecard record does not exist for that date."
QUIT
+26 SET CANRET=$$CANRET(PRSIEN,PRSDT,PRSD,PPI)
+27 IF 'CANRET
WRITE " ?? ",$CHAR(7),$PIECE(CANRET,U,3)
End DoDot:1
if CANRET!OUT
QUIT
+28 if OUT!('CANRET)
QUIT
+29 ;
+30 DO POCDSPLY^PRSNRUT0(PRSIEN,PRSDT,PRSDT)
+31 ;
+32 ; Confirm that the user does want to return the record
+33 ;
+34 NEW DIR,X,Y,DIRUT
+35 SET DIR(0)="Y"
+36 SET DIR("B")="YES"
+37 SET DIR("A",1)="Are you sure you want to return this Nurse's"
+38 SET DIR("A")=$SELECT($PIECE(CANRET,U,2)="R":"daily record",1:"entire pay period")_" for editing"
+39 SET DIR("?")="Accept the default YES or enter NO"
+40 DO ^DIR
+41 if $DATA(DIRUT)!'$GET(Y)
QUIT
+42 ;
+43 ; Lookup Record
+44 ;
+45 ; Confirm return or display a status message that record can't be returned.
+46 ; Display Record on that date?
+47 ;
+48 ; if pp status is R then it must be a return of a daily correction
+49 ; otherwise we return the whole pay period.
+50 ;
+51 IF $PIECE(CANRET,U,2)="R"
Begin DoDot:1
+52 DO UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","E")
+53 WRITE !,"POC daily record successfully returned."
End DoDot:1
+54 IF '$TEST
Begin DoDot:1
+55 DO UPDTPOC^PRSNCGR1(PPI,PRSIEN,"E",1)
+56 WRITE !,"POC pay period successfully returned."
End DoDot:1
+57 ;
+58 QUIT
+59 ;
CANRET(PRSIEN,PRSDT,PRSD,PPI) ; Return true if the record on the specified date
+1 ; is allowed to be deleted, otherwise return an error message.
+2 ;
+3 NEW CANRET,PRSDTDAT,PDAYSTAT,PPSTAT
+4 SET CANRET=0
+5 ;
+6 ;
+7 ; check does record exist
+8 ;
+9 IF '+$GET(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0))
Begin DoDot:1
+10 SET CANRET="0^^POC record does not exist for that date."
End DoDot:1
QUIT CANRET
+11 ;
+12 ; if pay period status is only (A)pproved then this pay
+13 ; pay period record has never been released and can be
+14 ; returned
+15 ;
+16 SET PPSTAT=$PIECE($GET(^PRSN(451,PPI,"E",PRSIEN,0)),U,2)
+17 IF PPSTAT="A"
SET CANRET="1"_U_PPSTAT_U
QUIT CANRET
+18 ;
+19 IF PPSTAT="E"
Begin DoDot:1
+20 SET CANRET="0"_U_PPSTAT_U_"POC record status is Entered. It does not need to be returned. It is currently available for editing."
End DoDot:1
QUIT CANRET
+21 ;
+22 ; If pay period status is released we need to check the status
+23 ; of individual days to determine if Coordinator can return
+24 ;
+25 SET PDAYSTAT=$PIECE($GET(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
+26 ;
+27 IF PDAYSTAT=""
Begin DoDot:1
+28 SET CANRET="0"_U_PPSTAT_U_"Record does not need to be returned. It is currently available for editing."
End DoDot:1
QUIT CANRET
+29 ;
+30 ; status A can be returned, otherwise it's Entered or Released
+31 ; and can already be edited or deleted or approved.
+32 ;
+33 IF PDAYSTAT="A"
Begin DoDot:1
+34 SET CANRET="1"_U_PPSTAT_U
End DoDot:1
+35 IF '$TEST
Begin DoDot:1
+36 SET CANRET="0"_U_PPSTAT_U_"POC record status is "_$SELECT(PDAYSTAT="E":"Entered",1:"Released")_". It is currently available for editing."
End DoDot:1
+37 ;
+38 ;
+39 QUIT CANRET
+40 ;
