Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSNCR1

PRSNCR1.m

Go to the documentation of this file.
  1. PRSNCR1 ;WOIFO/DAM - Return Approved POC Record;10/28/09
  1. ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
  1. ;;Per VHA Directive 2004-038, this routine should not be modified
  1. Q
  1. RETPOC ; called from option Return Approved Nurse POC Daily Time Record
  1. N GROUP,PRSIEN,VALUE,CANRET
  1. D PIKGROUP^PRSNUT04(.GROUP,"",0)
  1. ; quit if any error during group selection
  1. I $P($G(GROUP(0)),U,2)="E" W !!,?4,$P(GROUP(0),U,3) S X=$$ASK^PRSLIB00(1) Q
  1. S VALUE=+GROUP($O(GROUP(0)))
  1. Q:VALUE'>0
  1. ;
  1. ; Select Nurse
  1. ;
  1. S PRSIEN=+$$PICKNURS^PRSNUT03($P(GROUP(0),U,2),VALUE)
  1. Q:+PRSIEN'>0
  1. ;
  1. ; Allow user to select a date and reprompt if record is not valid
  1. ; for return
  1. ;
  1. N %DT,Y,X,OUT
  1. S (CANRET,OUT)=0
  1. S %DT="A"
  1. F D Q:CANRET!OUT
  1. . D ^%DT
  1. . I $G(X)[U!($G(X)="")!(Y'>0) S OUT=1 Q
  1. . S PRSDT=Y
  1. . S PRSDTDAT=$G(^PRST(458,"AD",PRSDT))
  1. . S PPI=$P(PRSDTDAT,U),PRSD=$P(PRSDTDAT,U,2)
  1. . I (PRSD'>0)!(PPI'>0) W " ?? ",$C(7),"ETA Timecard record does not exist for that date." Q
  1. . S CANRET=$$CANRET(PRSIEN,PRSDT,PRSD,PPI)
  1. . I 'CANRET W " ?? ",$C(7),$P(CANRET,U,3)
  1. Q:OUT!('CANRET)
  1. ;
  1. D POCDSPLY^PRSNRUT0(PRSIEN,PRSDT,PRSDT)
  1. ;
  1. ; Confirm that the user does want to return the record
  1. ;
  1. N DIR,X,Y,DIRUT
  1. S DIR(0)="Y"
  1. S DIR("B")="YES"
  1. S DIR("A",1)="Are you sure you want to return this Nurse's"
  1. S DIR("A")=$S($P(CANRET,U,2)="R":"daily record",1:"entire pay period")_" for editing"
  1. S DIR("?")="Accept the default YES or enter NO"
  1. D ^DIR
  1. Q:$D(DIRUT)!'$G(Y)
  1. ;
  1. ; Lookup Record
  1. ;
  1. ; Confirm return or display a status message that record can't be returned.
  1. ; Display Record on that date?
  1. ;
  1. ; if pp status is R then it must be a return of a daily correction
  1. ; otherwise we return the whole pay period.
  1. ;
  1. I $P(CANRET,U,2)="R" D
  1. . D UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","E")
  1. . W !,"POC daily record successfully returned."
  1. E D
  1. . D UPDTPOC^PRSNCGR1(PPI,PRSIEN,"E",1)
  1. . W !,"POC pay period successfully returned."
  1. ;
  1. Q
  1. ;
  1. 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.
  1. ;
  1. N CANRET,PRSDTDAT,PDAYSTAT,PPSTAT
  1. S CANRET=0
  1. ;
  1. ;
  1. ; check does record exist
  1. ;
  1. I '+$G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)) D Q CANRET
  1. . S CANRET="0^^POC record does not exist for that date."
  1. ;
  1. ; if pay period status is only (A)pproved then this pay
  1. ; pay period record has never been released and can be
  1. ; returned
  1. ;
  1. S PPSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,0)),U,2)
  1. I PPSTAT="A" S CANRET="1"_U_PPSTAT_U Q CANRET
  1. ;
  1. I PPSTAT="E" D Q CANRET
  1. . S CANRET="0"_U_PPSTAT_U_"POC record status is Entered. It does not need to be returned. It is currently available for editing."
  1. ;
  1. ; If pay period status is released we need to check the status
  1. ; of individual days to determine if Coordinator can return
  1. ;
  1. S PDAYSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
  1. ;
  1. I PDAYSTAT="" D Q CANRET
  1. . S CANRET="0"_U_PPSTAT_U_"Record does not need to be returned. It is currently available for editing."
  1. ;
  1. ; status A can be returned, otherwise it's Entered or Released
  1. ; and can already be edited or deleted or approved.
  1. ;
  1. I PDAYSTAT="A" D
  1. . S CANRET="1"_U_PPSTAT_U
  1. E D
  1. . S CANRET="0"_U_PPSTAT_U_"POC record status is "_$S(PDAYSTAT="E":"Entered",1:"Released")_". It is currently available for editing."
  1. ;
  1. ;
  1. Q CANRET
  1. ;