PRSRAU1 ;HISC/JH-PRIOR PAY PERIOD ADJUSTMENT AUDIT REPORT ;07-SEP-2000
;;4.0;PAID;**2,16,19,35,60**;Sep 21, 1995
SUP S PRSTLV=3,PRSR=1
D TLESEL^PRSRUT0
G Q1:$G(TLE)=""!(SSN="") G EN1
;
FIS S PRSR=2,PRSTLV=3
D TLESEL^PRSRUT0
G Q1:TLE=""!(SSN="")
;
EN1 W ! S X="T",%DT="" D ^%DT Q:Y<0 S DT=Y K %DT
;
ASK ;
D PPRANGE^PRSAPPU(.FR,.TO,.FR4Y,.TO4Y)
G Q1:'(FR4Y&TO4Y)
W !,"This report could take some time, remember to QUEUE the report."
S ZTRTN="START^PRSRAU1"
S ZTDESC="PAY PERIOD ADJ. AUDIT REPORT"
D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
;
START ;
N PPDAY,PP4Y
S (CNT,POUT)=0
K ^TMP($J,"AUD")
S ^TMP($J,"AUD")="PRIOR PAY PERIOD ADJUSTMENT REPORT"
;
;Function returns 4 dig yr pay per. 2/4 digit yr may be passed.
;
S DA(4)=$$PREP^PRSAPPU(FR) ; get previous pay period
F S DA(4)=$O(^PRST(458,"AB",DA(4))) Q:DA(4)=""!(DA(4)]TO4Y) D
. S DA(3)=$O(^PRST(458,"AB",DA(4),0))
. S D0=0
. F S D0=$O(^PRST(458,DA(3),"E",D0)) Q:D0'>0 S X=$E($P($G(^PRST(458,DA(3),"E",D0,5)),"^"),22,24) D:$P(TLE(1),"^")=X
.. S NAM=$P(^PRSPC(D0,0),"^")
.. S DA=0
.. F I=0:0 S DA=$O(^PRST(458,DA(3),"E",D0,"X",DA)) Q:DA'>0 D
... S AUDIT=$G(^PRST(458,DA(3),"E",D0,"X",DA,0))
... Q:AUDIT=""
... S TYPE=$P(AUDIT,U,4)
... S RAUDIT=$S(TYPE="T":$P($G(^PRST(458,DA(3),"E",D0,"X",DA,1)),"^"),1:1)
... S RAUDIT=$P($G(^PRST(458,DA(3),1)),"^",RAUDIT)
... S DAUDIT=$P(AUDIT,U,2)
... I DAUDIT'="" S DAUDIT=$E(DAUDIT,4,5)_"/"_$E(DAUDIT,6,7)_"/"_$E(DAUDIT,2,3)
... S AUDITOR=$S($P(AUDIT,U,3)'="":$P(^VA(200,$P(AUDIT,U,3),0),U),1:"")
... S STATUS=$P(AUDIT,U,5)
... S PCLERK=$S($P(AUDIT,U,6)'="":$P($G(^VA(200,$P(AUDIT,U,6),0)),U),1:"")
... S CDATE=$P(AUDIT,U,7)
... I CDATE'="" S CDATE=$E(CDATE,4,5)_"/"_$E(CDATE,6,7)_"/"_$E(CDATE,2,3)
... S APRV=$S($P(AUDIT,U,8)'="":$P(^VA(200,$P(AUDIT,U,8),0),U),1:"")
... S APRVD=$P(AUDIT,U,9)
... I APRVD'="" S APRVD=$E(APRVD,4,5)_"/"_$E(APRVD,6,7)_"/"_$E(APRVD,2,3)
... S APSUP=$S($P(AUDIT,U,10)'="":$P(^VA(200,$P(AUDIT,U,10),0),U),1:"")
... S APSUPD=$P(AUDIT,U,11)
... I APSUPD'="" S APSUPD=$E(APSUPD,4,5)_"/"_$E(APSUPD,6,7)_"/"_$E(APSUPD,2,3)
... S CNT=CNT+1
... S ^TMP($J,"AUD",TLE(1),RAUDIT,NAM,CNT)=DAUDIT_"^"_AUDITOR_"^"_TYPE_"^"_STATUS_"^"_PCLERK_"^"_CDATE_"^"_APRV_"^"_APRVD_"^"_APSUP_"^"_APSUPD
... W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
... Q
.. Q
. Q
IND S DAT2=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
U IO I 'CNT S TL(0)=TLE(1) W:$E(IOST,1,2)="C-" @IOF D G Q1
.D HDR1^PRSRAU11
.W !,"|",?10,"No Audit Data on File within this Date Range.",?79,"|"
.S POUT=1
.D NONE
D ^PRSRAU11
Q1 K %,%DT,C,CODE,FOOT,TLE,CNT,D0,DA,DAT2,DTOUT,POP,DIC,EDT,FR,TO,FR4Y,TO4Y,FRP,FRPP,P1,PP,PPE,PRSAI,PRSR,PRSTLV,SEL
K %Z,APRV,APRVD,APSUP,APSUPD,AUDIT,AUDITOR,CDATE,DATA,DATE,DAUDIT,II,J,JJ,PCLERK,RAUDIT,REC,STATUS
K I,NAM,POUT,SSN,STAT,SW,TL,TO,TYP,TYPE,USR,X,XX,Y,YY,Z1,ZTDESC,ZTRTN,ZTSAVE,^TMP($J) D ^%ZISC S:$D(ZTSK) ZTREQ="@" K ZTSK D HOME^%ZIS
Q
NONE F I=$Y:1:IOSL-9 D VLIN1^PRSRAU11
D HDR^PRSRAU11
Q
MSG2 W !,*7,"You entered a beginning Pay Period that is greater than the ending Pay Period.",! G ASK
LOOP F X="FR*","TO*","TL*","TLE*","SSN","XX","YY","SW" S ZTSAVE(X)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSRAU1 3342 printed Dec 13, 2024@02:28:24 Page 2
PRSRAU1 ;HISC/JH-PRIOR PAY PERIOD ADJUSTMENT AUDIT REPORT ;07-SEP-2000
+1 ;;4.0;PAID;**2,16,19,35,60**;Sep 21, 1995
SUP SET PRSTLV=3
SET PRSR=1
+1 DO TLESEL^PRSRUT0
+2 if $GET(TLE)=""!(SSN="")
GOTO Q1
GOTO EN1
+3 ;
FIS SET PRSR=2
SET PRSTLV=3
+1 DO TLESEL^PRSRUT0
+2 if TLE=""!(SSN="")
GOTO Q1
+3 ;
EN1 WRITE !
SET X="T"
SET %DT=""
DO ^%DT
if Y<0
QUIT
SET DT=Y
KILL %DT
+1 ;
ASK ;
+1 DO PPRANGE^PRSAPPU(.FR,.TO,.FR4Y,.TO4Y)
+2 if '(FR4Y&TO4Y)
GOTO Q1
+3 WRITE !,"This report could take some time, remember to QUEUE the report."
+4 SET ZTRTN="START^PRSRAU1"
+5 SET ZTDESC="PAY PERIOD ADJ. AUDIT REPORT"
+6 DO ST^PRSRUTL
DO LOOP
DO QUE1^PRSRUT0
if POP!($DATA(ZTSK))
GOTO Q1
+7 ;
START ;
+1 NEW PPDAY,PP4Y
+2 SET (CNT,POUT)=0
+3 KILL ^TMP($JOB,"AUD")
+4 SET ^TMP($JOB,"AUD")="PRIOR PAY PERIOD ADJUSTMENT REPORT"
+5 ;
+6 ;Function returns 4 dig yr pay per. 2/4 digit yr may be passed.
+7 ;
+8 ; get previous pay period
SET DA(4)=$$PREP^PRSAPPU(FR)
+9 FOR
SET DA(4)=$ORDER(^PRST(458,"AB",DA(4)))
if DA(4)=""!(DA(4)]TO4Y)
QUIT
Begin DoDot:1
+10 SET DA(3)=$ORDER(^PRST(458,"AB",DA(4),0))
+11 SET D0=0
+12 FOR
SET D0=$ORDER(^PRST(458,DA(3),"E",D0))
if D0'>0
QUIT
SET X=$EXTRACT($PIECE($GET(^PRST(458,DA(3),"E",D0,5)),"^"),22,24)
if $PIECE(TLE(1),"^")=X
Begin DoDot:2
+13 SET NAM=$PIECE(^PRSPC(D0,0),"^")
+14 SET DA=0
+15 FOR I=0:0
SET DA=$ORDER(^PRST(458,DA(3),"E",D0,"X",DA))
if DA'>0
QUIT
Begin DoDot:3
+16 SET AUDIT=$GET(^PRST(458,DA(3),"E",D0,"X",DA,0))
+17 if AUDIT=""
QUIT
+18 SET TYPE=$PIECE(AUDIT,U,4)
+19 SET RAUDIT=$SELECT(TYPE="T":$PIECE($GET(^PRST(458,DA(3),"E",D0,"X",DA,1)),"^"),1:1)
+20 SET RAUDIT=$PIECE($GET(^PRST(458,DA(3),1)),"^",RAUDIT)
+21 SET DAUDIT=$PIECE(AUDIT,U,2)
+22 IF DAUDIT'=""
SET DAUDIT=$EXTRACT(DAUDIT,4,5)_"/"_$EXTRACT(DAUDIT,6,7)_"/"_$EXTRACT(DAUDIT,2,3)
+23 SET AUDITOR=$SELECT($PIECE(AUDIT,U,3)'="":$PIECE(^VA(200,$PIECE(AUDIT,U,3),0),U),1:"")
+24 SET STATUS=$PIECE(AUDIT,U,5)
+25 SET PCLERK=$SELECT($PIECE(AUDIT,U,6)'="":$PIECE($GET(^VA(200,$PIECE(AUDIT,U,6),0)),U),1:"")
+26 SET CDATE=$PIECE(AUDIT,U,7)
+27 IF CDATE'=""
SET CDATE=$EXTRACT(CDATE,4,5)_"/"_$EXTRACT(CDATE,6,7)_"/"_$EXTRACT(CDATE,2,3)
+28 SET APRV=$SELECT($PIECE(AUDIT,U,8)'="":$PIECE(^VA(200,$PIECE(AUDIT,U,8),0),U),1:"")
+29 SET APRVD=$PIECE(AUDIT,U,9)
+30 IF APRVD'=""
SET APRVD=$EXTRACT(APRVD,4,5)_"/"_$EXTRACT(APRVD,6,7)_"/"_$EXTRACT(APRVD,2,3)
+31 SET APSUP=$SELECT($PIECE(AUDIT,U,10)'="":$PIECE(^VA(200,$PIECE(AUDIT,U,10),0),U),1:"")
+32 SET APSUPD=$PIECE(AUDIT,U,11)
+33 IF APSUPD'=""
SET APSUPD=$EXTRACT(APSUPD,4,5)_"/"_$EXTRACT(APSUPD,6,7)_"/"_$EXTRACT(APSUPD,2,3)
+34 SET CNT=CNT+1
+35 SET ^TMP($JOB,"AUD",TLE(1),RAUDIT,NAM,CNT)=DAUDIT_"^"_AUDITOR_"^"_TYPE_"^"_STATUS_"^"_PCLERK_"^"_CDATE_"^"_APRV_"^"_APRVD_"^"_APSUP_"^"_APSUPD
+36 if '$DATA(ZTSK)&($EXTRACT(IOST)'="P")&($RANDOM(30))
WRITE "."
+37 QUIT
End DoDot:3
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
IND SET DAT2=$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)
+1 USE IO
IF 'CNT
SET TL(0)=TLE(1)
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
Begin DoDot:1
+2 DO HDR1^PRSRAU11
+3 WRITE !,"|",?10,"No Audit Data on File within this Date Range.",?79,"|"
+4 SET POUT=1
+5 DO NONE
End DoDot:1
GOTO Q1
+6 DO ^PRSRAU11
Q1 KILL %,%DT,C,CODE,FOOT,TLE,CNT,D0,DA,DAT2,DTOUT,POP,DIC,EDT,FR,TO,FR4Y,TO4Y,FRP,FRPP,P1,PP,PPE,PRSAI,PRSR,PRSTLV,SEL
+1 KILL %Z,APRV,APRVD,APSUP,APSUPD,AUDIT,AUDITOR,CDATE,DATA,DATE,DAUDIT,II,J,JJ,PCLERK,RAUDIT,REC,STATUS
+2 KILL I,NAM,POUT,SSN,STAT,SW,TL,TO,TYP,TYPE,USR,X,XX,Y,YY,Z1,ZTDESC,ZTRTN,ZTSAVE,^TMP($JOB)
DO ^%ZISC
if $DATA(ZTSK)
SET ZTREQ="@"
KILL ZTSK
DO HOME^%ZIS
+3 QUIT
NONE FOR I=$Y:1:IOSL-9
DO VLIN1^PRSRAU11
+1 DO HDR^PRSRAU11
+2 QUIT
MSG2 WRITE !,*7,"You entered a beginning Pay Period that is greater than the ending Pay Period.",!
GOTO ASK
LOOP FOR X="FR*","TO*","TL*","TLE*","SSN","XX","YY","SW"
SET ZTSAVE(X)=""
+1 QUIT
