PRSNDPC1 ;WOIFO/DAM - Delete POC Records;10/28/09
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified
Q
DELPOC ; called from option Delete Nurse POC Daily Time Record
N GROUP,PRSIEN,VALUE,CANDEL
D ACCESS^PRSNUT02(.GROUP,"E",DT,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)
;
; Allow user to select a date and reprompt if record is not valid
; for deletion
;
N %DT,Y,X,OUT
S (CANDEL,OUT)=0
S %DT="A"
F D Q:CANDEL!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 PRSNVER=$O(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,"V",999),-1)
. S CANDEL=$$CANDEL(PRSIEN,PRSDT,PRSD,PPI,PRSNVER)
. I 'CANDEL W " ?? ",$C(7),$P(CANDEL,U,2)
Q:OUT!('CANDEL)
;
D POCDSPLY^PRSNRUT0(PRSIEN,PRSDT,PRSDT)
;
; Confirm that the user does want to Delete the record
;
N DIR,X,Y,DIRUT
S DIR(0)="Y"
S DIR("B")="YES"
S DIR("A")="Are you sure you want to Delete this record"
S DIR("?")="Accept the default YES or enter NO"
D ^DIR
Q:$D(DIRUT)!'$G(Y)
;
; Lookup Record
;
; Confirm deletion or status message that record can't be deleted
; Display Record on that date?
;
;
I $$EDVDEL(PRSIEN,PRSD,PPI,PRSNVER) D
. W !,"POC record successfully deleted."
E D
. W !,"Could not delete POC record."
;
Q
EDVDEL(PRSIEN,PRSD,PPI,PRSNVER) ; DELETE RECORD FUNCTION
; RETURNS 1 IF RECORD IS DELETED OTHERWISE 0
;
N PRSNA,X,RETURN
S RETURN=0
Q:'PRSNVER RETURN
I PRSNVER>1 D
. S PRSNA="451;;"_PPI_"~451.09;;"_PRSIEN_"~451.99;;"_PRSD_"~451.999;^PRSN(451,PPI,""E"",PRSIEN,""D"",PRSD,""V"",;"_PRSNVER
.; if version is 2 set daily record status back to null (no correction)
.; if greater than 2 set status back to released.
. I PRSNVER=2 D UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","")
. I PRSNVER>2 D UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","R")
.;
E D
. S PRSNA="451;;"_PPI_"~451.09;;"_PRSIEN_"~451.99;^PRSN(451,PPI,""E"",PRSIEN,""D"",;"_PRSD
;
K X D DELETE^PRSU1B1(.X,PRSNA)
I X S RETURN=1
QUIT RETURN
;
CANDEL(PRSIEN,PRSDT,PRSD,PPI,VERSION) ; Return true if the record on the specified date
; is allowed to be deleted, otherwise return an error message.
;
N CANDEL,PRSDTDAT,PDAYSTAT,PPSTAT
S CANDEL=0
;
; check for a valid date
;
I (PRSD'>0)!(PPI'>0) S CANDEL="0^Timecard record does not exist for that date." Q CANDEL
;
; check does record exist
;
I '+$G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)) D Q CANDEL
. S CANDEL="0^POC record does not exist for that date."
;
; if pay period status is only entered (E) then this record
; hasn't been anywhere and they can delete it.
;
S PPSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,0)),U,2)
Q:PPSTAT="E" 1
;
I PPSTAT="A" D Q CANDEL
. S CANDEL="0^POC record status is Approved and never Released. To delete record, VANOD site coordinator must first return record for editing."
;
; If the pay period is already release we need to check the status
; of individual days to determine if DEP can delete, but we can never
; delete version 1 of a release POC
;
I VERSION=1 D Q CANDEL
. S CANDEL="0^The POC record status is Released. Can't delete."
;
S PDAYSTAT=$P($G(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
;
I PDAYSTAT="" D Q CANDEL
. S CANDEL="0^The POC record status is Released. Can't delete."
;
I PDAYSTAT="E" D
. S CANDEL=1
E D
. S CANDEL="0"_U_"POC record status is "_$S(PDAYSTAT="A":"Approved",1:"Released")_". Can't delete."
Q CANDEL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNDPC1 3914 printed Sep 23, 2025@20:03:35 Page 2
PRSNDPC1 ;WOIFO/DAM - Delete POC Records;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
DELPOC ; called from option Delete Nurse POC Daily Time Record
+1 NEW GROUP,PRSIEN,VALUE,CANDEL
+2 DO ACCESS^PRSNUT02(.GROUP,"E",DT,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 ;
+12 ; Allow user to select a date and reprompt if record is not valid
+13 ; for deletion
+14 ;
+15 NEW %DT,Y,X,OUT
+16 SET (CANDEL,OUT)=0
+17 SET %DT="A"
+18 FOR
Begin DoDot:1
+19 DO ^%DT
+20 IF $GET(X)[U!($GET(X)="")!(Y'>0)
SET OUT=1
QUIT
+21 SET PRSDT=Y
+22 SET PRSDTDAT=$GET(^PRST(458,"AD",PRSDT))
+23 SET PPI=$PIECE(PRSDTDAT,U)
SET PRSD=$PIECE(PRSDTDAT,U,2)
+24 IF (PRSD'>0)!(PPI'>0)
WRITE " ?? ",$CHAR(7),"ETA Timecard record does not exist for that date."
QUIT
+25 SET PRSNVER=$ORDER(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,"V",999),-1)
+26 SET CANDEL=$$CANDEL(PRSIEN,PRSDT,PRSD,PPI,PRSNVER)
+27 IF 'CANDEL
WRITE " ?? ",$CHAR(7),$PIECE(CANDEL,U,2)
End DoDot:1
if CANDEL!OUT
QUIT
+28 if OUT!('CANDEL)
QUIT
+29 ;
+30 DO POCDSPLY^PRSNRUT0(PRSIEN,PRSDT,PRSDT)
+31 ;
+32 ; Confirm that the user does want to Delete the record
+33 ;
+34 NEW DIR,X,Y,DIRUT
+35 SET DIR(0)="Y"
+36 SET DIR("B")="YES"
+37 SET DIR("A")="Are you sure you want to Delete this record"
+38 SET DIR("?")="Accept the default YES or enter NO"
+39 DO ^DIR
+40 if $DATA(DIRUT)!'$GET(Y)
QUIT
+41 ;
+42 ; Lookup Record
+43 ;
+44 ; Confirm deletion or status message that record can't be deleted
+45 ; Display Record on that date?
+46 ;
+47 ;
+48 IF $$EDVDEL(PRSIEN,PRSD,PPI,PRSNVER)
Begin DoDot:1
+49 WRITE !,"POC record successfully deleted."
End DoDot:1
+50 IF '$TEST
Begin DoDot:1
+51 WRITE !,"Could not delete POC record."
End DoDot:1
+52 ;
+53 QUIT
EDVDEL(PRSIEN,PRSD,PPI,PRSNVER) ; DELETE RECORD FUNCTION
+1 ; RETURNS 1 IF RECORD IS DELETED OTHERWISE 0
+2 ;
+3 NEW PRSNA,X,RETURN
+4 SET RETURN=0
+5 if 'PRSNVER
QUIT RETURN
+6 IF PRSNVER>1
Begin DoDot:1
+7 SET PRSNA="451;;"_PPI_"~451.09;;"_PRSIEN_"~451.99;;"_PRSD_"~451.999;^PRSN(451,PPI,""E"",PRSIEN,""D"",PRSD,""V"",;"_PRSNVER
+8 ; if version is 2 set daily record status back to null (no correction)
+9 ; if greater than 2 set status back to released.
+10 IF PRSNVER=2
DO UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","")
+11 IF PRSNVER>2
DO UPDTPOCD^PRSNCGP(PPI,PRSIEN,PRSD,"","R")
+12 ;
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET PRSNA="451;;"_PPI_"~451.09;;"_PRSIEN_"~451.99;^PRSN(451,PPI,""E"",PRSIEN,""D"",;"_PRSD
End DoDot:1
+15 ;
+16 KILL X
DO DELETE^PRSU1B1(.X,PRSNA)
+17 IF X
SET RETURN=1
+18 QUIT RETURN
+19 ;
CANDEL(PRSIEN,PRSDT,PRSD,PPI,VERSION) ; Return true if the record on the specified date
+1 ; is allowed to be deleted, otherwise return an error message.
+2 ;
+3 NEW CANDEL,PRSDTDAT,PDAYSTAT,PPSTAT
+4 SET CANDEL=0
+5 ;
+6 ; check for a valid date
+7 ;
+8 IF (PRSD'>0)!(PPI'>0)
SET CANDEL="0^Timecard record does not exist for that date."
QUIT CANDEL
+9 ;
+10 ; check does record exist
+11 ;
+12 IF '+$GET(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0))
Begin DoDot:1
+13 SET CANDEL="0^POC record does not exist for that date."
End DoDot:1
QUIT CANDEL
+14 ;
+15 ; if pay period status is only entered (E) then this record
+16 ; hasn't been anywhere and they can delete it.
+17 ;
+18 SET PPSTAT=$PIECE($GET(^PRSN(451,PPI,"E",PRSIEN,0)),U,2)
+19 if PPSTAT="E"
QUIT 1
+20 ;
+21 IF PPSTAT="A"
Begin DoDot:1
+22 SET CANDEL="0^POC record status is Approved and never Released. To delete record, VANOD site coordinator must first return record for editing."
End DoDot:1
QUIT CANDEL
+23 ;
+24 ; If the pay period is already release we need to check the status
+25 ; of individual days to determine if DEP can delete, but we can never
+26 ; delete version 1 of a release POC
+27 ;
+28 IF VERSION=1
Begin DoDot:1
+29 SET CANDEL="0^The POC record status is Released. Can't delete."
End DoDot:1
QUIT CANDEL
+30 ;
+31 SET PDAYSTAT=$PIECE($GET(^PRSN(451,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
+32 ;
+33 IF PDAYSTAT=""
Begin DoDot:1
+34 SET CANDEL="0^The POC record status is Released. Can't delete."
End DoDot:1
QUIT CANDEL
+35 ;
+36 IF PDAYSTAT="E"
Begin DoDot:1
+37 SET CANDEL=1
End DoDot:1
+38 IF '$TEST
Begin DoDot:1
+39 SET CANDEL="0"_U_"POC record status is "_$SELECT(PDAYSTAT="A":"Approved",1:"Released")_". Can't delete."
End DoDot:1
+40 QUIT CANDEL
+41 ;
