PRSNAC01 ;WOIFO/DWA - Approval for Corrected Nurse POC records;10/5/2009
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038,this routine should not be modified.
Q
EN ; Entry point for approval of POC records for a pay period.
N A,CHECK,IEN200,PRSD,PRSPPD,PRSIEN,PRSSN,POCREC,PRSVER,POCSEG
N POCCNT,DIR,FOUND,GROUP,GRPIEN,GRPSC,GRPNM,I,LOC,POCP,POCC,REC
N STOP,ZEROFND,PRSDAY,PRSDIV,PRSDIVE,PRSDIVI,PRSPRM
S STOP=0
D ACCESS^PRSNUT02(.GROUP,"A",DT)
I $P($G(GROUP(0)),U,2)="E" D Q
. W !!,"There are no groups assigned or selected."
;
S PRSPRM=$P(GROUP(0),U,2)
S GRPNM=0,GRPNM=$O(GROUP(GRPNM))
S GRPIEN=$P(GROUP(GRPNM),U)
I PRSPRM="N" S GRPSC=$P(^NURSF(211.4,GRPIEN,0),U)
S PRSDIVI=$P(GROUP(GRPNM),U,2)
S PRSDIVE=$P(GROUP(GRPNM),U,3)
;
D LOCCOR
;
Q
;
;
LOCCOR ;
S LOC=0
F S LOC=$O(GROUP(LOC)) Q:LOC="" D
. I PRSPRM="N" S CHECK(+GROUP(LOC))=""
. I PRSPRM="T" S CHECK(LOC)=""
S (PRSDIV,ZEROFND)=0
F S PRSDIV=$O(^PRSN(451,"ACE",PRSDIV)) Q:'PRSDIV D Q:STOP
. S PRSPPD=0
. F S PRSPPD=$O(^PRSN(451,"ACE",PRSDIV,PRSPPD)) Q:'PRSPPD D Q:STOP
. . S PRSIEN=0
. . F S PRSIEN=$O(^PRSN(451,"ACE",PRSDIV,PRSPPD,PRSIEN)) Q:'PRSIEN D Q:STOP
. . . I PRSPRM="N" D GRPLOC
. . . I PRSPRM="T" D TLLOC
. . . Q:'FOUND
. . . S PRSDAY=0
. . . F S PRSDAY=$O(^PRSN(451,"ACE",PRSDIV,PRSPPD,PRSIEN,PRSDAY)) Q:'PRSDAY D Q:STOP
. . . . K POCP
. . . . D L1^PRSNRUT1(.POCP,PRSPPD,PRSIEN,PRSDAY,"P"),SETREC(.POCP)
. . . . K POCC
. . . . D L1^PRSNRUT1(.POCC,PRSPPD,PRSIEN,PRSDAY,"C"),SETREC(.POCC)
. . . . D DSPMM
. . . . Q:STOP
. . . . D DISPTM
. . . . Q:STOP
. . . . D ACTION
;
I 'ZEROFND W !!,"There are no corrected records to approve.",!!
;
Q
;
DISPTM ;Display the time records
D HDR
W !,?(80-26)/2,"** Previous Time Record **",!
D DSPREC(.POCP)
W !,?(80-26)/2,"** Current Time Record **",!
D DSPREC(.POCC)
Q
;
GRPLOC ; Find records for selected group
S FOUND=0
I $D(CHECK(+$$PRIMLOC^PRSNUT03(^PRSPC(PRSIEN,200)))) S (FOUND,ZEROFND)=1
;
Q
;
TLLOC ; Find records for selected T&L Unit
S FOUND=0
N TLE
S TLE=$P(^PRSPC(PRSIEN,0),U,8)
;separated employee, get T&L from archived time record
I TLE="" D
.N PAYPRD
.S PAYPRD=$P($G(^PRST(458,PRSPPD,0)),U)
.D CHECKTLE^PRSADP2(PAYPRD,PRSIEN,.TLE)
.Q
Q:TLE=""
I $D(CHECK(TLE)) S (FOUND,ZEROFND)=1
;
Q
;
SETREC(REC) ; Set up current record for display
S A=0
F S A=$O(REC(A)) Q:'A D
. S PRSVER=$P(REC(A),U,11)
. S:$P(REC(A),U,5)]""&($P(REC(A),U,5)?1.N) $P(REC(A),U,5)=$P($$ISACTIVE^PRSNUT01(DT,$P(REC(A),U,5)),U,2)
. S:$P(REC(A),U,6)]""&($P(REC(A),U,6)?1.N) $P(REC(A),U,6)=$P(^PRSN(451.5,$P(REC(A),U,6),0),U,2)
. S:$P(REC(A),U,8)]""&($P(REC(A),U,8)?1.N) $P(REC(A),U,8)=$P(^PRSN(451.6,$P(REC(A),U,8),0),U,2)
. QUIT
I $O(REC(0)) S $P(REC($O(REC(0))),U,12)=$P(^PRST(458,PRSPPD,2),U,PRSDAY)
;
Q
;
DSPREC(REC) ; Display current record
N A
S A=0
;I REC(0)=0 W ?(80-20)/2,"Time Record Deleted",!
F S A=$O(REC(A)) Q:'A D Q:STOP
. W $P($P(REC(A),U,12)," "),?12,$P(REC(A),U),?21,$P(REC(A),U,3)
. W ?28,$P(REC(A),U,4),?38,$P($P(REC(A),U,5)," ")
. W ?51,$P($P(REC(A),U,6)," "),?64,$P($P(REC(A),U,8)," ")
. W ?77,$P(REC(A),U,7),!
. W $P($P(REC(A),U,12)," ",2,999),?12,$P(REC(A),U,2),?38
. W $P($P(REC(A),U,5)," ",2),?51,$P($P(REC(A),U,6)," ",2),?64
. W $P($P(REC(A),U,8)," ",2),!
. ;
. I (IOSL-6)<$Y S STOP=$$ASK^PRSLIB00() I 'STOP D HDR W !
;
Q
;
DSPMM ; Display the mismatch report before asking for approval
D PPMM^PRSNRMM(PRSIEN,PRSPPD,,.STOP)
Q:STOP
W !!,?5,"Return to Approvals.",!
S STOP=$$ASK^PRSLIB00(1)
;
Q
;
ACTION ; Approve or Bypass current record
N DIR,X,Y
S DIR("A")="Enter an 'A' to Approve or Return to Bypass: "
S DIR(0)="SAO^A:Approve" D ^DIR
I Y="" Q
I Y["^" S STOP=1 Q
I Y="A" D UPDTPOCD^PRSNCGP(PRSPPD,PRSIEN,PRSDAY,PRSVER,Y)
;
Q
;
HDR ; Header for display of records
W:$E(IOST,1,2)="C-" @IOF
W $P(^PRSPC(PRSIEN,0),U),?(80-28)/2,"Approve Corrected POC Record"
W ?63,$S(PRSPRM="N":"Location: "_GRPNM,1:"T&L Unit: "_GRPNM),!
W ?58,"SSN: ",$E($P(^PRSPC(PRSIEN,0),U,9)),"XXXXX",$E($P(^PRSPC(PRSIEN,0),U,9),6,9),!
W "Date",?12,"Start/",?20,"Meal",?26,"Type of",?38,"Location",?51
W "Type of",?66,"OT",?76,"OT",!
W ?12,"Stop",?27,"Time",?52,"Work",?64,"Reason",?75,"Mand",!
F I=1:1:80 W "-"
;
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNAC01 4420 printed Apr 09, 2024@21:27:43 Page 2
PRSNAC01 ;WOIFO/DWA - Approval for Corrected Nurse POC records;10/5/2009
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038,this routine should not be modified.
+3 QUIT
EN ; Entry point for approval of POC records for a pay period.
+1 NEW A,CHECK,IEN200,PRSD,PRSPPD,PRSIEN,PRSSN,POCREC,PRSVER,POCSEG
+2 NEW POCCNT,DIR,FOUND,GROUP,GRPIEN,GRPSC,GRPNM,I,LOC,POCP,POCC,REC
+3 NEW STOP,ZEROFND,PRSDAY,PRSDIV,PRSDIVE,PRSDIVI,PRSPRM
+4 SET STOP=0
+5 DO ACCESS^PRSNUT02(.GROUP,"A",DT)
+6 IF $PIECE($GET(GROUP(0)),U,2)="E"
Begin DoDot:1
+7 WRITE !!,"There are no groups assigned or selected."
End DoDot:1
QUIT
+8 ;
+9 SET PRSPRM=$PIECE(GROUP(0),U,2)
+10 SET GRPNM=0
SET GRPNM=$ORDER(GROUP(GRPNM))
+11 SET GRPIEN=$PIECE(GROUP(GRPNM),U)
+12 IF PRSPRM="N"
SET GRPSC=$PIECE(^NURSF(211.4,GRPIEN,0),U)
+13 SET PRSDIVI=$PIECE(GROUP(GRPNM),U,2)
+14 SET PRSDIVE=$PIECE(GROUP(GRPNM),U,3)
+15 ;
+16 DO LOCCOR
+17 ;
+18 QUIT
+19 ;
+20 ;
LOCCOR ;
+1 SET LOC=0
+2 FOR
SET LOC=$ORDER(GROUP(LOC))
if LOC=""
QUIT
Begin DoDot:1
+3 IF PRSPRM="N"
SET CHECK(+GROUP(LOC))=""
+4 IF PRSPRM="T"
SET CHECK(LOC)=""
End DoDot:1
+5 SET (PRSDIV,ZEROFND)=0
+6 FOR
SET PRSDIV=$ORDER(^PRSN(451,"ACE",PRSDIV))
if 'PRSDIV
QUIT
Begin DoDot:1
+7 SET PRSPPD=0
+8 FOR
SET PRSPPD=$ORDER(^PRSN(451,"ACE",PRSDIV,PRSPPD))
if 'PRSPPD
QUIT
Begin DoDot:2
+9 SET PRSIEN=0
+10 FOR
SET PRSIEN=$ORDER(^PRSN(451,"ACE",PRSDIV,PRSPPD,PRSIEN))
if 'PRSIEN
QUIT
Begin DoDot:3
+11 IF PRSPRM="N"
DO GRPLOC
+12 IF PRSPRM="T"
DO TLLOC
+13 if 'FOUND
QUIT
+14 SET PRSDAY=0
+15 FOR
SET PRSDAY=$ORDER(^PRSN(451,"ACE",PRSDIV,PRSPPD,PRSIEN,PRSDAY))
if 'PRSDAY
QUIT
Begin DoDot:4
+16 KILL POCP
+17 DO L1^PRSNRUT1(.POCP,PRSPPD,PRSIEN,PRSDAY,"P")
DO SETREC(.POCP)
+18 KILL POCC
+19 DO L1^PRSNRUT1(.POCC,PRSPPD,PRSIEN,PRSDAY,"C")
DO SETREC(.POCC)
+20 DO DSPMM
+21 if STOP
QUIT
+22 DO DISPTM
+23 if STOP
QUIT
+24 DO ACTION
End DoDot:4
if STOP
QUIT
End DoDot:3
if STOP
QUIT
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+25 ;
+26 IF 'ZEROFND
WRITE !!,"There are no corrected records to approve.",!!
+27 ;
+28 QUIT
+29 ;
DISPTM ;Display the time records
+1 DO HDR
+2 WRITE !,?(80-26)/2,"** Previous Time Record **",!
+3 DO DSPREC(.POCP)
+4 WRITE !,?(80-26)/2,"** Current Time Record **",!
+5 DO DSPREC(.POCC)
+6 QUIT
+7 ;
GRPLOC ; Find records for selected group
+1 SET FOUND=0
+2 IF $DATA(CHECK(+$$PRIMLOC^PRSNUT03(^PRSPC(PRSIEN,200))))
SET (FOUND,ZEROFND)=1
+3 ;
+4 QUIT
+5 ;
TLLOC ; Find records for selected T&L Unit
+1 SET FOUND=0
+2 NEW TLE
+3 SET TLE=$PIECE(^PRSPC(PRSIEN,0),U,8)
+4 ;separated employee, get T&L from archived time record
+5 IF TLE=""
Begin DoDot:1
+6 NEW PAYPRD
+7 SET PAYPRD=$PIECE($GET(^PRST(458,PRSPPD,0)),U)
+8 DO CHECKTLE^PRSADP2(PAYPRD,PRSIEN,.TLE)
+9 QUIT
End DoDot:1
+10 if TLE=""
QUIT
+11 IF $DATA(CHECK(TLE))
SET (FOUND,ZEROFND)=1
+12 ;
+13 QUIT
+14 ;
SETREC(REC) ; Set up current record for display
+1 SET A=0
+2 FOR
SET A=$ORDER(REC(A))
if 'A
QUIT
Begin DoDot:1
+3 SET PRSVER=$PIECE(REC(A),U,11)
+4 if $PIECE(REC(A),U,5)]""&($PIECE(REC(A),U,5)?1.N)
SET $PIECE(REC(A),U,5)=$PIECE($$ISACTIVE^PRSNUT01(DT,$PIECE(REC(A),U,5)),U,2)
+5 if $PIECE(REC(A),U,6)]""&($PIECE(REC(A),U,6)?1.N)
SET $PIECE(REC(A),U,6)=$PIECE(^PRSN(451.5,$PIECE(REC(A),U,6),0),U,2)
+6 if $PIECE(REC(A),U,8)]""&($PIECE(REC(A),U,8)?1.N)
SET $PIECE(REC(A),U,8)=$PIECE(^PRSN(451.6,$PIECE(REC(A),U,8),0),U,2)
+7 QUIT
End DoDot:1
+8 IF $ORDER(REC(0))
SET $PIECE(REC($ORDER(REC(0))),U,12)=$PIECE(^PRST(458,PRSPPD,2),U,PRSDAY)
+9 ;
+10 QUIT
+11 ;
DSPREC(REC) ; Display current record
+1 NEW A
+2 SET A=0
+3 ;I REC(0)=0 W ?(80-20)/2,"Time Record Deleted",!
+4 FOR
SET A=$ORDER(REC(A))
if 'A
QUIT
Begin DoDot:1
+5 WRITE $PIECE($PIECE(REC(A),U,12)," "),?12,$PIECE(REC(A),U),?21,$PIECE(REC(A),U,3)
+6 WRITE ?28,$PIECE(REC(A),U,4),?38,$PIECE($PIECE(REC(A),U,5)," ")
+7 WRITE ?51,$PIECE($PIECE(REC(A),U,6)," "),?64,$PIECE($PIECE(REC(A),U,8)," ")
+8 WRITE ?77,$PIECE(REC(A),U,7),!
+9 WRITE $PIECE($PIECE(REC(A),U,12)," ",2,999),?12,$PIECE(REC(A),U,2),?38
+10 WRITE $PIECE($PIECE(REC(A),U,5)," ",2),?51,$PIECE($PIECE(REC(A),U,6)," ",2),?64
+11 WRITE $PIECE($PIECE(REC(A),U,8)," ",2),!
+12 ;
+13 IF (IOSL-6)<$Y
SET STOP=$$ASK^PRSLIB00()
IF 'STOP
DO HDR
WRITE !
End DoDot:1
if STOP
QUIT
+14 ;
+15 QUIT
+16 ;
DSPMM ; Display the mismatch report before asking for approval
+1 DO PPMM^PRSNRMM(PRSIEN,PRSPPD,,.STOP)
+2 if STOP
QUIT
+3 WRITE !!,?5,"Return to Approvals.",!
+4 SET STOP=$$ASK^PRSLIB00(1)
+5 ;
+6 QUIT
+7 ;
ACTION ; Approve or Bypass current record
+1 NEW DIR,X,Y
+2 SET DIR("A")="Enter an 'A' to Approve or Return to Bypass: "
+3 SET DIR(0)="SAO^A:Approve"
DO ^DIR
+4 IF Y=""
QUIT
+5 IF Y["^"
SET STOP=1
QUIT
+6 IF Y="A"
DO UPDTPOCD^PRSNCGP(PRSPPD,PRSIEN,PRSDAY,PRSVER,Y)
+7 ;
+8 QUIT
+9 ;
HDR ; Header for display of records
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 WRITE $PIECE(^PRSPC(PRSIEN,0),U),?(80-28)/2,"Approve Corrected POC Record"
+3 WRITE ?63,$SELECT(PRSPRM="N":"Location: "_GRPNM,1:"T&L Unit: "_GRPNM),!
+4 WRITE ?58,"SSN: ",$EXTRACT($PIECE(^PRSPC(PRSIEN,0),U,9)),"XXXXX",$EXTRACT($PIECE(^PRSPC(PRSIEN,0),U,9),6,9),!
+5 WRITE "Date",?12,"Start/",?20,"Meal",?26,"Type of",?38,"Location",?51
+6 WRITE "Type of",?66,"OT",?76,"OT",!
+7 WRITE ?12,"Stop",?27,"Time",?52,"Work",?64,"Reason",?75,"Mand",!
+8 FOR I=1:1:80
WRITE "-"
+9 ;
+10 ;
+11 QUIT
