source: FOIAVistA/trunk/r/PAID-PRS/PRSRAU1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PRSRAU1 ;HISC/JH-PRIOR PAY PERIOD ADJUSTMENT AUDIT REPORT ;07-SEP-2000
2 ;;4.0;PAID;**2,16,19,35,60**;Sep 21, 1995
3SUP S PRSTLV=3,PRSR=1
4 D TLESEL^PRSRUT0
5 G Q1:$G(TLE)=""!(SSN="") G EN1
6 ;
7FIS S PRSR=2,PRSTLV=3
8 D TLESEL^PRSRUT0
9 G Q1:TLE=""!(SSN="")
10 ;
11EN1 W ! S X="T",%DT="" D ^%DT Q:Y<0 S DT=Y K %DT
12 ;
13ASK ;
14 D PPRANGE^PRSAPPU(.FR,.TO,.FR4Y,.TO4Y)
15 G Q1:'(FR4Y&TO4Y)
16 W !,"This report could take some time, remember to QUEUE the report."
17 S ZTRTN="START^PRSRAU1"
18 S ZTDESC="PAY PERIOD ADJ. AUDIT REPORT"
19 D ST^PRSRUTL,LOOP,QUE1^PRSRUT0 G Q1:POP!($D(ZTSK))
20 ;
21START ;
22 N PPDAY,PP4Y
23 S (CNT,POUT)=0
24 K ^TMP($J,"AUD")
25 S ^TMP($J,"AUD")="PRIOR PAY PERIOD ADJUSTMENT REPORT"
26 ;
27 ;Function returns 4 dig yr pay per. 2/4 digit yr may be passed.
28 ;
29 S DA(4)=$$PREP^PRSAPPU(FR) ; get previous pay period
30 F S DA(4)=$O(^PRST(458,"AB",DA(4))) Q:DA(4)=""!(DA(4)]TO4Y) D
31 . S DA(3)=$O(^PRST(458,"AB",DA(4),0))
32 . S D0=0
33 . 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
34 .. S NAM=$P(^PRSPC(D0,0),"^")
35 .. S DA=0
36 .. F I=0:0 S DA=$O(^PRST(458,DA(3),"E",D0,"X",DA)) Q:DA'>0 D
37 ... S AUDIT=$G(^PRST(458,DA(3),"E",D0,"X",DA,0))
38 ... Q:AUDIT=""
39 ... S TYPE=$P(AUDIT,U,4)
40 ... S RAUDIT=$S(TYPE="T":$P($G(^PRST(458,DA(3),"E",D0,"X",DA,1)),"^"),1:1)
41 ... S RAUDIT=$P($G(^PRST(458,DA(3),1)),"^",RAUDIT)
42 ... S DAUDIT=$P(AUDIT,U,2)
43 ... I DAUDIT'="" S DAUDIT=$E(DAUDIT,4,5)_"/"_$E(DAUDIT,6,7)_"/"_$E(DAUDIT,2,3)
44 ... S AUDITOR=$S($P(AUDIT,U,3)'="":$P(^VA(200,$P(AUDIT,U,3),0),U),1:"")
45 ... S STATUS=$P(AUDIT,U,5)
46 ... S PCLERK=$S($P(AUDIT,U,6)'="":$P($G(^VA(200,$P(AUDIT,U,6),0)),U),1:"")
47 ... S CDATE=$P(AUDIT,U,7)
48 ... I CDATE'="" S CDATE=$E(CDATE,4,5)_"/"_$E(CDATE,6,7)_"/"_$E(CDATE,2,3)
49 ... S APRV=$S($P(AUDIT,U,8)'="":$P(^VA(200,$P(AUDIT,U,8),0),U),1:"")
50 ... S APRVD=$P(AUDIT,U,9)
51 ... I APRVD'="" S APRVD=$E(APRVD,4,5)_"/"_$E(APRVD,6,7)_"/"_$E(APRVD,2,3)
52 ... S APSUP=$S($P(AUDIT,U,10)'="":$P(^VA(200,$P(AUDIT,U,10),0),U),1:"")
53 ... S APSUPD=$P(AUDIT,U,11)
54 ... I APSUPD'="" S APSUPD=$E(APSUPD,4,5)_"/"_$E(APSUPD,6,7)_"/"_$E(APSUPD,2,3)
55 ... S CNT=CNT+1
56 ... S ^TMP($J,"AUD",TLE(1),RAUDIT,NAM,CNT)=DAUDIT_"^"_AUDITOR_"^"_TYPE_"^"_STATUS_"^"_PCLERK_"^"_CDATE_"^"_APRV_"^"_APRVD_"^"_APSUP_"^"_APSUPD
57 ... W:'$D(ZTSK)&($E(IOST)'="P")&($R(30)) "."
58 ... Q
59 .. Q
60 . Q
61IND S DAT2=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
62 U IO I 'CNT S TL(0)=TLE(1) W:$E(IOST,1,2)="C-" @IOF D G Q1
63 .D HDR1^PRSRAU11
64 .W !,"|",?10,"No Audit Data on File within this Date Range.",?79,"|"
65 .S POUT=1
66 .D NONE
67 D ^PRSRAU11
68Q1 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
69 K %Z,APRV,APRVD,APSUP,APSUPD,AUDIT,AUDITOR,CDATE,DATA,DATE,DAUDIT,II,J,JJ,PCLERK,RAUDIT,REC,STATUS
70 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
71 Q
72NONE F I=$Y:1:IOSL-9 D VLIN1^PRSRAU11
73 D HDR^PRSRAU11
74 Q
75MSG2 W !,*7,"You entered a beginning Pay Period that is greater than the ending Pay Period.",! G ASK
76LOOP F X="FR*","TO*","TL*","TLE*","SSN","XX","YY","SW" S ZTSAVE(X)=""
77 Q
Note: See TracBrowser for help on using the repository browser.