- 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 Feb 18, 2025@23:54:55 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