source: FOIAVistA/tag/r/PAID-PRS/PRS8VW.m@ 1540

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

WorldVistAEHR overlayed on FOIAVistA

File size: 3.4 KB
Line 
1PRS8VW ;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 ;
36CERT ; 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
59E2 ; --- create E array
60 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT"
61 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH"
62 S E(3)="NLDWMLCAPCCYFE" Q
63STUB ; --- 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 ;
70E ; --- create E array
71 S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEAEBTATCFAFCADNT"
72 S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSECEDTBTDFBFDAFNH"
73 S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD" Q
74CTID ; 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 TracBrowser for help on using the repository browser.