source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8VW.m@ 619

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1PRS8VW ;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 ;
39CERT ; 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
64E2 ; --- create E array
65 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDND"
66 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNU"
67 S E(3)="NLDWMLCAPCCYFE" Q
68STUB ; --- 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 ;
75E ; --- create E array
76 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNTRSSRSDND"
77 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNHRNSSSHNU"
78 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q
79CTID ; 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
Note: See TracBrowser for help on using the repository browser.