- 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 Feb 18, 2025@23:53:40 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 ;