- PRSAUDP ; WOIFO/DWA - Display Employee Pay Period Audit Data ;12/3/07
- ;;4.0;PAID;**116,132**;Sep 21, 1995;Build 13
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;called by PRSADP2
- D RET Q:QT
- S STATYPE=$P(^DD(458.1101,4,0),"^",3),PRSTW=$$TWE^PRSATE0(DFN,$S($G(PPI)]"":PPI,1:""))
- S PG=PG+1,X=$G(^PRSPC(DFN,0)) W @IOF,!,?3,$P(X,U,1),?45,"Telework Ind. ",$S($P(PRSTW,U,3)]"":$P(PRSTW,U,3),$P(PRSTW,U)]""&($G(PPI)=""):$P(PRSTW,U),1:"None") S X=$P(X,U,9)
- I '$G(PRSTLV)!($G(PRSTLV)=1) W ?68,"XXX-XX-",$E(X,6,9)
- I $G(PRSTLV)=2!($G(PRSTLV)=3) W ?68,$E(X),"XX-XX-",$E(X,6,9)
- I $G(PRSTLV)=7 W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
- W !,?26,"Corrected T&A History",!!
- AUN S AUN=0 F S AUN=$O(^PRST(458,PPI,"E",DFN,"X",AUN)) Q:AUN=""!(QT=1) D B
- W @IOF
- EX K AUN,AX0,B,CA,CB,CC,CD,DAY,DB,DISP,DTE,IFN,J,TYP,X,STATYPE,STATUS,LNE,DFN,AUR,PRSTW
- Q
- B S B=-1 S B=$O(^PRST(458,PPI,"E",DFN,"X",AUN,B)) Q:B=""!(QT=1) S AX0=$G(^(B))
- F CA=1:1:11 S AX0(CA)=$P(AX0,U,CA)
- S STDT="" F CB=2,11,9,7 S Y=AX0(CB) D DTP S AX0(CB)=Y S:Y'="" STDT=Y K Y ;date/time(s)
- F CC=3,6,8,10 I AX0(CC)]"" I $D(^VA(200,AX0(CC),0)) S AX0(CC)=$P(^VA(200,AX0(CC),0),U,1) ;names
- S TYP=AX0(4),LNE="" S $P(LNE,"-",80)="" S STATUS=$P($P(STATYPE,AX0(5)_":",2),";",1)
- Q:TYP'?1U Q:"TVH"'[TYP D @TYP
- I $D(^PRST(458,PPI,"E",DFN,"X",AUN,7)) W !!,"Change Remarks: ",^(7)
- D RET Q
- RET I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X[U) QT=1 W @IOF
- Q
- T ;Time/Tour Change
- W !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT S IFN=AUN S DAY=$P($G(^PRST(458,PPI,"E",DFN,"X",IFN,1)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",+DAY) D GET^PRSAPPP,DIS^PRSAPPQ
- W !!?27,"* * * Corrected Data * * *" S IFN=AUN+1 D GET^PRSAPPP,DIS^PRSAPPQ W !,LNE,!
- Q
- V ;VCS Sales Change
- W !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT S IFN=AUN D GET^PRSAPPP S Z=AUR(1) D VCS^PRSAPPQ
- W !!?27,"* * * Corrected Data * * *" S IFN=AUN+1 D GET^PRSAPPP S Z=AUR(1) D VCS^PRSAPPQ W !,LNE,!
- Q
- H ;Hazard Change
- W !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT S IFN=AUN D GET^PRSAPPP S Z=AUR(1) D ED^PRSAPPQ
- W !!?27,"* * * Corrected Data * * *" S IFN=AUN+1 D GET^PRSAPPP S Z=AUR(1) D ED^PRSAPPQ W !,LNE,!
- Q
- DTP ; Printable Date/Time
- Q:'Y S %=Y,Y=$J(+$E(Y,6,7),2)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(Y,4,5))_"-"_$E(Y,2,3)
- S:%#1 %=+$E(%_"0",9,10)_"^"_$E(%_"000",11,12),Y=Y_$J($S(%>12:%-12,1:+%),3)_":"_$P(%,"^",2)_$S(%<12:"am",%<24:"pm",1:"m") K % Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAUDP 2526 printed Mar 13, 2025@21:29:59 Page 2
- PRSAUDP ; WOIFO/DWA - Display Employee Pay Period Audit Data ;12/3/07
- +1 ;;4.0;PAID;**116,132**;Sep 21, 1995;Build 13
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;called by PRSADP2
- +4 DO RET
- if QT
- QUIT
- +5 SET STATYPE=$PIECE(^DD(458.1101,4,0),"^",3)
- SET PRSTW=$$TWE^PRSATE0(DFN,$SELECT($GET(PPI)]"":PPI,1:""))
- +6 SET PG=PG+1
- SET X=$GET(^PRSPC(DFN,0))
- WRITE @IOF,!,?3,$PIECE(X,U,1),?45,"Telework Ind. ",$SELECT($PIECE(PRSTW,U,3)]"":$PIECE(PRSTW,U,3),$PIECE(PRSTW,U)]""&($GET(PPI)=""):$PIECE(PRSTW,U),1:"None")
- SET X=$PIECE(X,U,9)
- +7 IF '$GET(PRSTLV)!($GET(PRSTLV)=1)
- WRITE ?68,"XXX-XX-",$EXTRACT(X,6,9)
- +8 IF $GET(PRSTLV)=2!($GET(PRSTLV)=3)
- WRITE ?68,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
- +9 IF $GET(PRSTLV)=7
- WRITE ?68,$EXTRACT(X,1,3),"-",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,9)
- +10 WRITE !,?26,"Corrected T&A History",!!
- AUN SET AUN=0
- FOR
- SET AUN=$ORDER(^PRST(458,PPI,"E",DFN,"X",AUN))
- if AUN=""!(QT=1)
- QUIT
- DO B
- +1 WRITE @IOF
- EX KILL AUN,AX0,B,CA,CB,CC,CD,DAY,DB,DISP,DTE,IFN,J,TYP,X,STATYPE,STATUS,LNE,DFN,AUR,PRSTW
- +1 QUIT
- B SET B=-1
- SET B=$ORDER(^PRST(458,PPI,"E",DFN,"X",AUN,B))
- if B=""!(QT=1)
- QUIT
- SET AX0=$GET(^(B))
- +1 FOR CA=1:1:11
- SET AX0(CA)=$PIECE(AX0,U,CA)
- +2 ;date/time(s)
- SET STDT=""
- FOR CB=2,11,9,7
- SET Y=AX0(CB)
- DO DTP
- SET AX0(CB)=Y
- if Y'=""
- SET STDT=Y
- KILL Y
- +3 ;names
- FOR CC=3,6,8,10
- IF AX0(CC)]""
- IF $DATA(^VA(200,AX0(CC),0))
- SET AX0(CC)=$PIECE(^VA(200,AX0(CC),0),U,1)
- +4 SET TYP=AX0(4)
- SET LNE=""
- SET $PIECE(LNE,"-",80)=""
- SET STATUS=$PIECE($PIECE(STATYPE,AX0(5)_":",2),";",1)
- +5 if TYP'?1U
- QUIT
- if "TVH"'[TYP
- QUIT
- DO @TYP
- +6 IF $DATA(^PRST(458,PPI,"E",DFN,"X",AUN,7))
- WRITE !!,"Change Remarks: ",^(7)
- +7 DO RET
- QUIT
- RET IF $EXTRACT(IOST,1,2)="C-"
- READ !!,"Press RETURN to Continue.",X:DTIME
- if '$TEST!(X[U)
- SET QT=1
- WRITE @IOF
- +1 QUIT
- T ;Time/Tour Change
- +1 WRITE !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT
- SET IFN=AUN
- SET DAY=$PIECE($GET(^PRST(458,PPI,"E",DFN,"X",IFN,1)),"^",1)
- SET DTE=$PIECE($GET(^PRST(458,PPI,2)),"^",+DAY)
- DO GET^PRSAPPP
- DO DIS^PRSAPPQ
- +2 WRITE !!?27,"* * * Corrected Data * * *"
- SET IFN=AUN+1
- DO GET^PRSAPPP
- DO DIS^PRSAPPQ
- WRITE !,LNE,!
- +3 QUIT
- V ;VCS Sales Change
- +1 WRITE !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT
- SET IFN=AUN
- DO GET^PRSAPPP
- SET Z=AUR(1)
- DO VCS^PRSAPPQ
- +2 WRITE !!?27,"* * * Corrected Data * * *"
- SET IFN=AUN+1
- DO GET^PRSAPPP
- SET Z=AUR(1)
- DO VCS^PRSAPPQ
- WRITE !,LNE,!
- +3 QUIT
- H ;Hazard Change
- +1 WRITE !,"Status: ",STATUS,?29,"* * * Prior Data * * *",?58,STDT
- SET IFN=AUN
- DO GET^PRSAPPP
- SET Z=AUR(1)
- DO ED^PRSAPPQ
- +2 WRITE !!?27,"* * * Corrected Data * * *"
- SET IFN=AUN+1
- DO GET^PRSAPPP
- SET Z=AUR(1)
- DO ED^PRSAPPQ
- WRITE !,LNE,!
- +3 QUIT
- DTP ; Printable Date/Time
- +1 if 'Y
- QUIT
- SET %=Y
- SET Y=$JUSTIFY(+$EXTRACT(Y,6,7),2)_"-"_$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$EXTRACT(Y,4,5))_"-"_$EXTRACT(Y,2,3)
- +2 if %#1
- SET %=+$EXTRACT(%_"0",9,10)_"^"_$EXTRACT(%_"000",11,12)
- SET Y=Y_$JUSTIFY($SELECT(%>12:%-12,1:+%),3)_":"_$PIECE(%,"^",2)_$SELECT(%<12:"am",%<24:"pm",1:"m")
- KILL %
- QUIT
