PRS8VW ;WCIOFO/JAH - DECOMPOSITION, VIEW RESULTS ;01/11/08
;;4.0;PAID;**2,6,27,45,112,117,132**;Sep 21, 1995;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine is used to view the results of the decomposition.
;The variables VAL and VALOLD must be passed. VAL is the current
;decomposition string. VALOLD, which may be null, is the results
;of a previous decomposition run (what's in the 5 node of file 458
;prior to running decomposition).
;
;Called by Routines: PRS8, PRS8DR
S (NEW,VAL)=$G(VAL),(OLD,VALOLD)=$G(VALOLD)
N DASH1,DASH2
S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="="
I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ; 33rd position because CP field
I +$E(OLD,2,4) S OLD=$E(VALOLD,33,999) ;is added(either "C","F"or" ")
D E
W @IOF
I "C"'[$E(IOST) D
.S X="Decomposition of Time" W ?(80-$L(X)/2),X,!
.D NOW^%DTC S Y=% X ^DD("DD")
.S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown")
.S TR=TR_" "
.S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X
S X=$P(C0,"^",1)_" [SSN: "_$P(C0,"^",9)_"]" W !,X
S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1)
D CTID
W !,DASH2
W !,"Loc.",?10,"Data Element",?44,"Code",?52,"Old Value",?67,"New Value"
W !,"----",?10,"------------",?44,"----",?52,"---------",?67,"---------"
K I,L,X,USED
D ^PRS8VW1
D STUB
I "C"'[$E(IOST) D
.W !,DASH1
.W !,TR
D ONE^PRS8CV,^%ZISC Q
;
CERT ; entry point to show supervisor result of decomp before certifying
N DASH1,DASH2
S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="="
S (NEW,VAL)=$G(VAL)
I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ;because CP field is added to STUB
D E2
W @IOF
I "C"'[$E(IOST) D
.S X="Decomposition of Time" W ?(80-$L(X)/2),X,!
.D NOW^%DTC S Y=% X ^DD("DD")
.S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown")
.S TR=TR_" "
.S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X
S H="PAY PERIOD SUMMARY" W !,$J(H,40+($L(H)/2)),!
S X=$P(C0,"^",1)_" [SSN: "_$E($P(C0,"^",9))_"XXXX"_$E($P(C0,"^",9),6,9)_"]" W !,X
S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1)
D CTID
W !,DASH2
W !
K I,L,X,USED
D ^PRS8VW2
I "C"'[$E(IOST) D
.W !,DASH1
.W !,TR
K H,R,Z Q
E2 ; --- create E array
S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDNDCFCHCPCRTWTSTM"
S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNUCGCICQCSTXTTTN"
S E(3)="NLDWMLCAPCCYFE" Q
STUB ; --- show stub record
S X1=$G(HDR),X2=$E(VAL,1,32)
I X1="" S X1=$E(VALOLD,1,32)
I X1="" S X1=X2
I $L(X1)<$L(X2) S X1=X2
W !!,"STUB RECORD >>>>> ",$S(X1'="":X1,1:"Not Available At this Time...") Q
;
E ; --- create E array
;PRS*4*132 add telework codes TW,TW,TM,TX,TT,TN
S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDNDCFCHCPCRTWTSTM"
S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNUCGCICQCSTXTTTN"
S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q
CTID ; compressed tour indicator display
; in - PY (pay period ien), DFN (employee ien)
N FLX,FLXP
S FLX=$P($G(^PRST(458,+PY,"E",DFN,0)),U,6) ; for current pay period
S FLXP=$P($G(^PRST(458,+PY-1,"E",DFN,0)),U,6) ; for previous pay period
I FLX]"",FLX'="0" D
. W !,"This is a ",$$EXTERNAL^DILFD(458.01,5,"",FLX)," tour!"
I FLX]"",FLXP]"",FLX'=FLXP D
. W !,"Note: The Compressed Tour Indicator has been changed since"
. W !," the previous pay period (from "
. W $$EXTERNAL^DILFD(458.01,5,"",FLXP)
. W " to ",$$EXTERNAL^DILFD(458.01,5,"",FLX),")."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8VW 3894 printed Dec 13, 2024@02:23:06 Page 2
PRS8VW ;WCIOFO/JAH - DECOMPOSITION, VIEW RESULTS ;01/11/08
+1 ;;4.0;PAID;**2,6,27,45,112,117,132**;Sep 21, 1995;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine is used to view the results of the decomposition.
+5 ;The variables VAL and VALOLD must be passed. VAL is the current
+6 ;decomposition string. VALOLD, which may be null, is the results
+7 ;of a previous decomposition run (what's in the 5 node of file 458
+8 ;prior to running decomposition).
+9 ;
+10 ;Called by Routines: PRS8, PRS8DR
+11 SET (NEW,VAL)=$GET(VAL)
SET (OLD,VALOLD)=$GET(VALOLD)
+12 NEW DASH1,DASH2
+13 SET $PIECE(DASH1,"-",79)="-"
SET $PIECE(DASH2,"=",79)="="
+14 ; 33rd position because CP field
IF +$EXTRACT(NEW,2,4)
SET NEW=$EXTRACT(VAL,33,999)
+15 ;is added(either "C","F"or" ")
IF +$EXTRACT(OLD,2,4)
SET OLD=$EXTRACT(VALOLD,33,999)
+16 DO E
+17 WRITE @IOF
+18 IF "C"'[$EXTRACT(IOST)
Begin DoDot:1
+19 SET X="Decomposition of Time"
WRITE ?(80-$LENGTH(X)/2),X,!
+20 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+21 SET X=$GET(^VA(200,+$GET(DUZ),0))
SET TR="User: "_$SELECT($PIECE(X,"^",1)'="":$PIECE(X,"^",1),1:"Unknown")
+22 SET TR=TR_" "
+23 SET X="Run Date: "_Y
SET TR=$EXTRACT(TR,1,(79-$LENGTH(X)))_X
End DoDot:1
+24 SET X=$PIECE(C0,"^",1)_" [SSN: "_$PIECE(C0,"^",9)_"]"
WRITE !,X
+25 SET X="Pay Period: "_(^PRST(458,+PY,0))
WRITE ?(79-$LENGTH(X)),$PIECE(X,"^",1)
+26 DO CTID
+27 WRITE !,DASH2
+28 WRITE !,"Loc.",?10,"Data Element",?44,"Code",?52,"Old Value",?67,"New Value"
+29 WRITE !,"----",?10,"------------",?44,"----",?52,"---------",?67,"---------"
+30 KILL I,L,X,USED
+31 DO ^PRS8VW1
+32 DO STUB
+33 IF "C"'[$EXTRACT(IOST)
Begin DoDot:1
+34 WRITE !,DASH1
+35 WRITE !,TR
End DoDot:1
+36 DO ONE^PRS8CV
DO ^%ZISC
QUIT
+37 ;
CERT ; entry point to show supervisor result of decomp before certifying
+1 NEW DASH1,DASH2
+2 SET $PIECE(DASH1,"-",79)="-"
SET $PIECE(DASH2,"=",79)="="
+3 SET (NEW,VAL)=$GET(VAL)
+4 ;because CP field is added to STUB
IF +$EXTRACT(NEW,2,4)
SET NEW=$EXTRACT(VAL,33,999)
+5 DO E2
+6 WRITE @IOF
+7 IF "C"'[$EXTRACT(IOST)
Begin DoDot:1
+8 SET X="Decomposition of Time"
WRITE ?(80-$LENGTH(X)/2),X,!
+9 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
+10 SET X=$GET(^VA(200,+$GET(DUZ),0))
SET TR="User: "_$SELECT($PIECE(X,"^",1)'="":$PIECE(X,"^",1),1:"Unknown")
+11 SET TR=TR_" "
+12 SET X="Run Date: "_Y
SET TR=$EXTRACT(TR,1,(79-$LENGTH(X)))_X
End DoDot:1
+13 SET H="PAY PERIOD SUMMARY"
WRITE !,$JUSTIFY(H,40+($LENGTH(H)/2)),!
+14 SET X=$PIECE(C0,"^",1)_" [SSN: "_$EXTRACT($PIECE(C0,"^",9))_"XXXX"_$EXTRACT($PIECE(C0,"^",9),6,9)_"]"
WRITE !,X
+15 SET X="Pay Period: "_(^PRST(458,+PY,0))
WRITE ?(79-$LENGTH(X)),$PIECE(X,"^",1)
+16 DO CTID
+17 WRITE !,DASH2
+18 WRITE !
+19 KILL I,L,X,USED
+20 DO ^PRS8VW2
+21 IF "C"'[$EXTRACT(IOST)
Begin DoDot:1
+22 WRITE !,DASH1
+23 WRITE !,TR
End DoDot:1
+24 KILL H,R,Z
QUIT
E2 ; --- create E array
+1 SET E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDNDCFCHCPCRTWTSTM"
+2 SET E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNUCGCICQCSTXTTTN"
+3 SET E(3)="NLDWMLCAPCCYFE"
QUIT
STUB ; --- show stub record
+1 SET X1=$GET(HDR)
SET X2=$EXTRACT(VAL,1,32)
+2 IF X1=""
SET X1=$EXTRACT(VALOLD,1,32)
+3 IF X1=""
SET X1=X2
+4 IF $LENGTH(X1)<$LENGTH(X2)
SET X1=X2
+5 WRITE !!,"STUB RECORD >>>>> ",$SELECT(X1'="":X1,1:"Not Available At this Time...")
QUIT
+6 ;
E ; --- create E array
+1 ;PRS*4*132 add telework codes TW,TW,TM,TX,TT,TN
+2 SET E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDNDCFCHCPCRTWTSTM"
+3 SET E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNUCGCICQCSTXTTTN"
+4 SET E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD"
QUIT
CTID ; compressed tour indicator display
+1 ; in - PY (pay period ien), DFN (employee ien)
+2 NEW FLX,FLXP
+3 ; for current pay period
SET FLX=$PIECE($GET(^PRST(458,+PY,"E",DFN,0)),U,6)
+4 ; for previous pay period
SET FLXP=$PIECE($GET(^PRST(458,+PY-1,"E",DFN,0)),U,6)
+5 IF FLX]""
IF FLX'="0"
Begin DoDot:1
+6 WRITE !,"This is a ",$$EXTERNAL^DILFD(458.01,5,"",FLX)," tour!"
End DoDot:1
+7 IF FLX]""
IF FLXP]""
IF FLX'=FLXP
Begin DoDot:1
+8 WRITE !,"Note: The Compressed Tour Indicator has been changed since"
+9 WRITE !," the previous pay period (from "
+10 WRITE $$EXTERNAL^DILFD(458.01,5,"",FLXP)
+11 WRITE " to ",$$EXTERNAL^DILFD(458.01,5,"",FLX),")."
End DoDot:1
+12 QUIT
