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

PRSRAU1.m

Go to the documentation of this file.
  1. PRSRAU1 ;HISC/JH-PRIOR PAY PERIOD ADJUSTMENT AUDIT REPORT ;07-SEP-2000
  1. ;;4.0;PAID;**2,16,19,35,60**;Sep 21, 1995
  1. SUP S PRSTLV=3,PRSR=1
  1. D TLESEL^PRSRUT0
  1. G Q1:$G(TLE)=""!(SSN="") G EN1
  1. ;
  1. FIS S PRSR=2,PRSTLV=3
  1. D TLESEL^PRSRUT0
  1. G Q1:TLE=""!(SSN="")
  1. ;
  1. EN1 W ! S X="T",%DT="" D ^%DT Q:Y<0 S DT=Y K %DT
  1. ;
  1. ASK ;
  1. D PPRANGE^PRSAPPU(.FR,.TO,.FR4Y,.TO4Y)
  1. G Q1:'(FR4Y&TO4Y)
  1. W !,"This report could take some time, remember to QUEUE the report."
  1. S ZTRTN="START^PRSRAU1"
  1. S ZTDESC="PAY PERIOD ADJ. AUDIT REPORT"
  1. D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
  1. ;
  1. START ;
  1. N PPDAY,PP4Y
  1. S (CNT,POUT)=0
  1. K ^TMP($J,"AUD")
  1. S ^TMP($J,"AUD")="PRIOR PAY PERIOD ADJUSTMENT REPORT"
  1. ;
  1. ;Function returns 4 dig yr pay per. 2/4 digit yr may be passed.
  1. ;
  1. S DA(4)=$$PREP^PRSAPPU(FR) ; get previous pay period
  1. F S DA(4)=$O(^PRST(458,"AB",DA(4))) Q:DA(4)=""!(DA(4)]TO4Y) D
  1. . S DA(3)=$O(^PRST(458,"AB",DA(4),0))
  1. . S D0=0
  1. . 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
  1. .. S NAM=$P(^PRSPC(D0,0),"^")
  1. .. S DA=0
  1. .. F I=0:0 S DA=$O(^PRST(458,DA(3),"E",D0,"X",DA)) Q:DA'>0 D
  1. ... S AUDIT=$G(^PRST(458,DA(3),"E",D0,"X",DA,0))
  1. ... Q:AUDIT=""
  1. ... S TYPE=$P(AUDIT,U,4)
  1. ... S RAUDIT=$S(TYPE="T":$P($G(^PRST(458,DA(3),"E",D0,"X",DA,1)),"^"),1:1)
  1. ... S RAUDIT=$P($G(^PRST(458,DA(3),1)),"^",RAUDIT)
  1. ... S DAUDIT=$P(AUDIT,U,2)
  1. ... I DAUDIT'="" S DAUDIT=$E(DAUDIT,4,5)_"/"_$E(DAUDIT,6,7)_"/"_$E(DAUDIT,2,3)
  1. ... S AUDITOR=$S($P(AUDIT,U,3)'="":$P(^VA(200,$P(AUDIT,U,3),0),U),1:"")
  1. ... S STATUS=$P(AUDIT,U,5)
  1. ... S PCLERK=$S($P(AUDIT,U,6)'="":$P($G(^VA(200,$P(AUDIT,U,6),0)),U),1:"")
  1. ... S CDATE=$P(AUDIT,U,7)
  1. ... I CDATE'="" S CDATE=$E(CDATE,4,5)_"/"_$E(CDATE,6,7)_"/"_$E(CDATE,2,3)
  1. ... S APRV=$S($P(AUDIT,U,8)'="":$P(^VA(200,$P(AUDIT,U,8),0),U),1:"")
  1. ... S APRVD=$P(AUDIT,U,9)
  1. ... I APRVD'="" S APRVD=$E(APRVD,4,5)_"/"_$E(APRVD,6,7)_"/"_$E(APRVD,2,3)
  1. ... S APSUP=$S($P(AUDIT,U,10)'="":$P(^VA(200,$P(AUDIT,U,10),0),U),1:"")
  1. ... S APSUPD=$P(AUDIT,U,11)
  1. ... I APSUPD'="" S APSUPD=$E(APSUPD,4,5)_"/"_$E(APSUPD,6,7)_"/"_$E(APSUPD,2,3)
  1. ... S CNT=CNT+1
  1. ... S ^TMP($J,"AUD",TLE(1),RAUDIT,NAM,CNT)=DAUDIT_"^"_AUDITOR_"^"_TYPE_"^"_STATUS_"^"_PCLERK_"^"_CDATE_"^"_APRV_"^"_APRVD_"^"_APSUP_"^"_APSUPD
  1. ... W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
  1. ... Q
  1. .. Q
  1. . Q
  1. IND S DAT2=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1. U IO I 'CNT S TL(0)=TLE(1) W:$E(IOST,1,2)="C-" @IOF D G Q1
  1. .D HDR1^PRSRAU11
  1. .W !,"|",?10,"No Audit Data on File within this Date Range.",?79,"|"
  1. .S POUT=1
  1. .D NONE
  1. D ^PRSRAU11
  1. 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
  1. K %Z,APRV,APRVD,APSUP,APSUPD,AUDIT,AUDITOR,CDATE,DATA,DATE,DAUDIT,II,J,JJ,PCLERK,RAUDIT,REC,STATUS
  1. 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
  1. Q
  1. NONE F I=$Y:1:IOSL-9 D VLIN1^PRSRAU11
  1. D HDR^PRSRAU11
  1. Q
  1. MSG2 W !,*7,"You entered a beginning Pay Period that is greater than the ending Pay Period.",! G ASK
  1. LOOP F X="FR*","TO*","TL*","TLE*","SSN","XX","YY","SW" S ZTSAVE(X)=""
  1. Q