| 1 | PRS8CR ;HISC/MRL-DECOMPOSITION, CREATE STRING ;8/23/01
|
|---|
| 2 | ;;4.0;PAID;**2,6,45,69**;Sep 21, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ;This routine take the information contained in the WK array
|
|---|
| 5 | ;and creates the activity string to be passed to Austin. The
|
|---|
| 6 | ;WK(1) node contains those items pertaining to Week 1 activity,
|
|---|
| 7 | ;WK(2) contains those items pertaining to Week 2 activity and
|
|---|
| 8 | ;WK(3) contains the Miscellaneous information shown on the bottom
|
|---|
| 9 | ;of the timecard.
|
|---|
| 10 | ;
|
|---|
| 11 | ;Called by Routines: PRS8DR
|
|---|
| 12 | ;
|
|---|
| 13 | ;Variable S contains the lengths of each of the Values for the
|
|---|
| 14 | ;different time codes. Used to format values with leading and
|
|---|
| 15 | ;trailing zero's
|
|---|
| 16 | N MLINHRS
|
|---|
| 17 | S MLINHRS=$$MLINHRS^PRSAENT(DFN)
|
|---|
| 18 | S S="33333333333333333333333333333333344362323333333"
|
|---|
| 19 | S E(1)="ANSKWDNOAURTCECUUNNANBSPSASBSCDADBDCTFOAOBOCYAOKOMRARBRCHAHBHCPTPAONYDHDVCEA EB TATCFAFCADNT"
|
|---|
| 20 | S E(2)="ALSLWPNPABRLCTCOUSNRNSSQSESFSGDEDFDGTGOEOFOGYEOSOURERFRGHLHMHNPHPBCLYHHOVSEC ED TBTDFBFDAFNH"
|
|---|
| 21 | S E(3)="NLDWINTLLULNLDDTTOLAMLCAPCCYRRFFFECD"
|
|---|
| 22 | K V S V="" F I=1,2,3 S V(I)=""
|
|---|
| 23 | ;
|
|---|
| 24 | ;Next section gets Week 1 and Week 2 data and stores in V(WK)
|
|---|
| 25 | F J=1,2 F I=1:1:38,40,42,43,44,45,46,47 S X=+$P(WK(J),"^",I) I X]"" D
|
|---|
| 26 | .I TYP'["D",I'=38,I'=40 D QH
|
|---|
| 27 | .I TYP["D" S X=+X_"0"
|
|---|
| 28 | .I TYP["Pd",$E(ENT,2)'="D",$P(WK(J),"^",32)="",V(J)="" S V(J)=V(J)_$S(J=1:"PT000",J=2:"PH000",1:"") ;for p/t drs put PT,PH in 8B string even if they are 0 (PT+PH=NH)
|
|---|
| 29 | .I I=32,TYP["P",TYP["N",TYP'["B"!(TYP["H"),'X D Q
|
|---|
| 30 | ..S X=$E("0000000",0,+$E(S,I)-$L(X))_X
|
|---|
| 31 | ..S V(J)=V(J)_$E(E(J),I+(I-1),I*2)_X
|
|---|
| 32 | ..Q
|
|---|
| 33 | .I I=37,$P(C0,"^",20)="P",$P(C0,"^",21)="U" D
|
|---|
| 34 | ..S X=$E("0000000",0,+$E(S,I)-$L(X))_X
|
|---|
| 35 | ..I 'X S V(J)=V(J)_$E(E(J),I+(I-1),I*2)_X
|
|---|
| 36 | ..Q
|
|---|
| 37 | .S X=+X I I=32,TYP["Pd",X=0 S X=1
|
|---|
| 38 | .Q:'X
|
|---|
| 39 | .I I=32,TYP["Pd",X=1 S X=0
|
|---|
| 40 | .I I=38!(I=40) D
|
|---|
| 41 | ..S Z=X,X=4*$P(WK(J),"^",I+1) D QH
|
|---|
| 42 | ..S X=($E("00",0,$E(S,I)-$L(Z))_+Z)_($E("000",0,$E(S,I+1)-$L(+X))_+X) ;combine env. diff. % and hours
|
|---|
| 43 | ..Q
|
|---|
| 44 | .E S X=$E("0000000",0,+$E(S,I)-$L(X))_+X
|
|---|
| 45 | .I +X S V(J)=V(J)_$E(E(J),I+(I-1),I*2)_X,V=V+X
|
|---|
| 46 | ;
|
|---|
| 47 | ;Now we get miscellaneous data
|
|---|
| 48 | ;
|
|---|
| 49 | S S="22134446114423146"
|
|---|
| 50 | F I=1:1:17 S X=$P(WK(3),"^",I) I X'="" D
|
|---|
| 51 | .I I=11 D
|
|---|
| 52 | . . I MLINHRS D QH ; Convert to 1/4 hours.
|
|---|
| 53 | . . I MLINHRS=0 S X=X_"0" ; Convert to 1/4 hours.
|
|---|
| 54 | .S X=$E("000000",0,+$E(S,I)-$L(X))_X
|
|---|
| 55 | .I $D(X) S V(3)=V(3)_$E(E(3),I+(I-1),I*2)_X,V=V+X
|
|---|
| 56 | ;
|
|---|
| 57 | ;finish up
|
|---|
| 58 | ;
|
|---|
| 59 | S VAL="" I $L(V(1))!($L(V(2)))!($L(V(3))) S X=V(1)_V(2)_V(3)_"CD"_$E("000000",0,6-$L(+V))_+V,VAL=X
|
|---|
| 60 | ;
|
|---|
| 61 | STUB ; --- enter here to create stub only
|
|---|
| 62 | I '($D(VAL)#2) S VAL=""
|
|---|
| 63 | ; code below to add CP field to STUB record (32nd position)
|
|---|
| 64 | S CPFX=""
|
|---|
| 65 | S CPFX=$P($G(^PRST(458,PY,"E",DFN,0)),"^",6) ;get CP from 458
|
|---|
| 66 | I CPFX="" S CPFX=$P($G(^PRSPC(DFN,1)),"^",7) ;if 458 null get from 450
|
|---|
| 67 | I "0"[CPFX S CPFX=" " ;if it is 0 or "" set CPFX = " "
|
|---|
| 68 | S PPE=$G(^PRST(458,+PY,0)),PPE=$P(PPE,"^",1),PPI=+PY D ^PRSAXSR
|
|---|
| 69 | S VAL=HDR_CPFX_VAL ;decomp no longer saves 8B in 5 node (6/95)
|
|---|
| 70 | K I,J,S Q
|
|---|
| 71 | ;
|
|---|
| 72 | QH ; --- for persons paid hourly/convert to Quarter Hours
|
|---|
| 73 | ;
|
|---|
| 74 | I I'=37 S X1=X#4,X=X\4_+X1 K X1
|
|---|
| 75 | Q
|
|---|
