Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRS8VW.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8VW.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8VW.m
r613 r623 1 PRS8VW ;HISC/MRL-DECOMPOSITION, VIEW RESULTS ;03/22/07 2 ;;4.0;PAID;**2,6,27,45,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;This routine is used to view the results of the decomposition. 6 ;The variables VAL and VALOLD must be passed. VAL is the current 7 ;decomposition string. VALOLD, which may be null, is the results 8 ;of a previous decomposition run (what's in the 5 node of file 458 9 ;prior to running decomposition). 10 ; 11 ;Called by Routines: PRS8, PRS8DR 12 S (NEW,VAL)=$G(VAL),(OLD,VALOLD)=$G(VALOLD) 13 N DASH1,DASH2 14 S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="=" 15 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ; 33rd position because CP field 16 I +$E(OLD,2,4) S OLD=$E(VALOLD,33,999) ;is added(either "C","F"or" ") 17 D E 18 W @IOF 19 I "C"'[$E(IOST) D 20 .S X="Decomposition of Time" W ?(80-$L(X)/2),X,! 21 .D NOW^%DTC S Y=% X ^DD("DD") 22 .S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown") 23 .S TR=TR_" " 24 .S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X 25 S X=$P(C0,"^",1)_" [SSN: "_$P(C0,"^",9)_"]" W !,X 26 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 27 D CTID 28 W !,DASH2 29 W !,"Loc.",?10,"Data Element",?44,"Code",?52,"Old Value",?67,"New Value" 30 W !,"----",?10,"------------",?44,"----",?52,"---------",?67,"---------" 31 K I,L,X,USED 32 D ^PRS8VW1 33 D STUB 34 I "C"'[$E(IOST) D 35 .W !,DASH1 36 .W !,TR 37 D ONE^PRS8CV,^%ZISC Q 38 ; 39 CERT ; entry point to show supervisor result of decomp before certifying 40 N DASH1,DASH2 41 S $P(DASH1,"-",79)="-",$P(DASH2,"=",79)="=" 42 S (NEW,VAL)=$G(VAL) 43 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ;because CP field is added to STUB 44 D E2 45 W @IOF 46 I "C"'[$E(IOST) D 47 .S X="Decomposition of Time" W ?(80-$L(X)/2),X,! 48 .D NOW^%DTC S Y=% X ^DD("DD") 49 .S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown") 50 .S TR=TR_" " 51 .S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X 52 S H="PAY PERIOD SUMMARY" W !,$J(H,40+($L(H)/2)),! 53 S X=$P(C0,"^",1)_" [SSN: "_$E($P(C0,"^",9))_"XXXX"_$E($P(C0,"^",9),6,9)_"]" W !,X 54 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 55 D CTID 56 W !,DASH2 57 W ! 58 K I,L,X,USED 59 D ^PRS8VW2 60 I "C"'[$E(IOST) D 61 .W !,DASH1 62 .W !,TR 63 K H,R,Z Q 64 E2 ; --- create E array 65 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDND" 66 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNU" 67 S E(3)="NLDWMLCAPCCYFE" Q 68 STUB ; --- show stub record 69 S X1=$G(HDR),X2=$E(VAL,1,32) 70 I X1="" S X1=$E(VALOLD,1,32) 71 I X1="" S X1=X2 72 I $L(X1)<$L(X2) S X1=X2 73 W !!,"STUB RECORD >>>>> ",$S(X1'="":X1,1:"Not Available At this Time...") Q 74 ; 75 E ; --- create E array 76 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDND" 77 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNU" 78 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q 79 CTID ; compressed tour indicator display 80 ; in - PY (pay period ien), DFN (employee ien) 81 N FLX,FLXP 82 S FLX=$P($G(^PRST(458,+PY,"E",DFN,0)),U,6) ; for current pay period 83 S FLXP=$P($G(^PRST(458,+PY-1,"E",DFN,0)),U,6) ; for previous pay period 84 I FLX]"",FLX'="0" D 85 . W !,"This is a ",$$EXTERNAL^DILFD(458.01,5,"",FLX)," tour!" 86 I FLX]"",FLXP]"",FLX'=FLXP D 87 . W !,"Note: The Compressed Tour Indicator has been changed since" 88 . W !," the previous pay period (from " 89 . W $$EXTERNAL^DILFD(458.01,5,"",FLXP) 90 . W " to ",$$EXTERNAL^DILFD(458.01,5,"",FLX),")." 91 Q 1 PRS8VW ;HISC/MRL-DECOMPOSITION, VIEW RESULTS ;11/4/97 2 ;;4.0;PAID;**2,6,27,45**;Sep 21, 1995 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 S (NEW,VAL)=$G(VAL),(OLD,VALOLD)=$G(VALOLD) 12 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ; 33rd position because CP field 13 I +$E(OLD,2,4) S OLD=$E(VALOLD,33,999) ;is added(either "C","F"or" ") 14 D E 15 W @IOF 16 I "C"'[$E(IOST) D 17 .S X="Decomposition of Time" W ?(80-$L(X)/2),X,! 18 .D NOW^%DTC S Y=% X ^DD("DD") 19 .S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown") 20 .S TR=TR_" " 21 .S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X 22 S X=$P(C0,"^",1)_" [SSN: "_$P(C0,"^",9)_"]" W !,X 23 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 24 D CTID 25 W ! F I=1:1:79 W "=" 26 W !,"Loc.",?10,"Data Element",?44,"Code",?52,"Old Value",?67,"New Value" 27 W !,"----",?10,"------------",?44,"----",?52,"---------",?67,"---------" 28 K I,L,X,USED 29 D ^PRS8VW1 30 D STUB 31 I "C"'[$E(IOST) D 32 .W ! F I=1:1:79 W "-" 33 .W !,TR 34 D ONE^PRS8CV,^%ZISC Q 35 ; 36 CERT ; entry point to show supervisor result of decomp before certifying 37 S (NEW,VAL)=$G(VAL) 38 I +$E(NEW,2,4) S NEW=$E(VAL,33,999) ;because CP field is added to STUB 39 D E2 40 W @IOF 41 I "C"'[$E(IOST) D 42 .S X="Decomposition of Time" W ?(80-$L(X)/2),X,! 43 .D NOW^%DTC S Y=% X ^DD("DD") 44 .S X=$G(^VA(200,+$G(DUZ),0)),TR="User: "_$S($P(X,"^",1)'="":$P(X,"^",1),1:"Unknown") 45 .S TR=TR_" " 46 .S X="Run Date: "_Y,TR=$E(TR,1,(79-$L(X)))_X 47 S H="PAY PERIOD SUMMARY" W !,$J(H,40+($L(H)/2)),! 48 S X=$P(C0,"^",1)_" [SSN: "_$P(C0,"^",9)_"]" W !,X 49 S X="Pay Period: "_(^PRST(458,+PY,0)) W ?(79-$L(X)),$P(X,"^",1) 50 D CTID 51 W ! F I=1:1:79 W "=" 52 W ! 53 K I,L,X,USED 54 D ^PRS8VW2 55 I "C"'[$E(IOST) D 56 .W ! F I=1:1:79 W "-" 57 .W !,TR 58 K H,R,Z Q 59 E2 ; --- create E array 60 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT" 61 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH" 62 S E(3)="NLDWMLCAPCCYFE" Q 63 STUB ; --- show stub record 64 S X1=$G(HDR),X2=$E(VAL,1,32) 65 I X1="" S X1=$E(VALOLD,1,32) 66 I X1="" S X1=X2 67 I $L(X1)<$L(X2) S X1=X2 68 W !!,"STUB RECORD >>>>> ",$S(X1'="":X1,1:"Not Available At this Time...") Q 69 ; 70 E ; --- create E array 71 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT" 72 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH" 73 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q 74 CTID ; compressed tour indicator display 75 ; in - PY (pay period ien), DFN (employee ien) 76 N FLX,FLXP 77 S FLX=$P($G(^PRST(458,+PY,"E",DFN,0)),U,6) ; for current pay period 78 S FLXP=$P($G(^PRST(458,+PY-1,"E",DFN,0)),U,6) ; for previous pay period 79 I FLX]"",FLX'="0" D 80 . W !,"This is a ",$$EXTERNAL^DILFD(458.01,5,"",FLX)," tour!" 81 I FLX]"",FLXP]"",FLX'=FLXP D 82 . W !,"Note: The Compressed Tour Indicator has been changed since" 83 . W !," the previous pay period (from " 84 . W $$EXTERNAL^DILFD(458.01,5,"",FLXP) 85 . W " to ",$$EXTERNAL^DILFD(458.01,5,"",FLX),")." 86 Q
Note:
See TracChangeset
for help on using the changeset viewer.
