189 lines
7.4 KiB
Mathematica
189 lines
7.4 KiB
Mathematica
PRSDUTIL ;HISC/MGD-PAID DOWNLOAD UTILITY SUB-ROUTINES ;09/10/2003
|
|
;;4.0;PAID;**32,82,99**;Sep 21, 1995
|
|
PIC9 ;Replace 0s
|
|
S DIF=LTH-$L(GRPVAL) I DIF>0 F FF=1:1:DIF S GRPVAL="0"_GRPVAL
|
|
K DIF,FF Q
|
|
SIGN ;Sign conversion
|
|
S L=$L(DATA),S=$E(DATA,L)
|
|
S LC=$S(S="{":0,S="A":1,S="B":2,S="C":3,S="D":4,S="E":5,S="F":6,S="G":7,S="H":8,S="I":9,S="}":0,S="J":1,S="K":2,S="L":3,S="M":4,S="N":5,S="O":6,S="P":7,S="Q":8,S="R":9,1:S)
|
|
S DATA=$E(DATA,1,L-1)_LC
|
|
S:(S="}")!(S="J")!(S="K")!(S="L")!(S="M")!(S="N")!(S="O")!(S="P")!(S="Q")!(S="R") DATA="-"_DATA
|
|
K L,LC,S Q
|
|
D ;.0
|
|
S L=$L(DATA),DATA=$E(DATA,1,L-1)_"."_$E(DATA,L) K L G RZ
|
|
DD ;.00
|
|
S L=$L(DATA),DATA=$E(DATA,1,L-2)_"."_$E(DATA,L-1,L) K L G RZ
|
|
DDD ;.000
|
|
S L=$L(DATA),DATA=$E(DATA,1,L-3)_"."_$E(DATA,L-2,L) K L G RZ
|
|
DDDD ;.0000
|
|
S L=$L(DATA),DATA=$E(DATA,1,L-4)_"."_$E(DATA,L-3,L) K L G RZ
|
|
DDDDD ;.00000
|
|
S L=$L(DATA),DATA=$E(DATA,1,L-5)_"."_$E(DATA,L-4,L) K L G RZ
|
|
AHRS ;Acct hrs
|
|
S L=$L(DATA),LD=$E(DATA,L),FD=$E(DATA,1,L-1)
|
|
S LD=$S(LD=0:"00",LD=1:25,LD=2:50,LD=3:75,1:LD)
|
|
S DATA=FD_"."_LD,DATA=+DATA
|
|
K FD,L,LD G RZ
|
|
PCT ;%
|
|
S:+$P(DATA,".",2)=0 DATA=DATA\1
|
|
S DATA=DATA_"%" Q
|
|
RZ ;Remove leading 0s
|
|
I +DATA=0 S DATA="" Q
|
|
S FC=$E(DATA,1)
|
|
S $P(DATA,".")=+$P(DATA,".")
|
|
I FC="-",$E(DATA,1)'="-" S DATA="-"_DATA
|
|
K FC Q
|
|
DATE ;Convert Austin Date to Fileman Date
|
|
;Austin's date has form xxYYMMDD or YYYYMMDD
|
|
Q:DATA=""
|
|
I $E(DATA,5,8)="0000" S DATA="" Q
|
|
N X,Y,%DT,DTOUT
|
|
S X=$E(DATA,5,8)_$S(+$E(DATA)'=$E(DATA):$E(DATA,3,4),1:$E(DATA,1,4))
|
|
S %DT="" D ^%DT
|
|
S DATA=$S(Y>0:Y,1:"")
|
|
Q
|
|
LZ ;Insert leading 0s
|
|
F UUU=1:1:L-$L(DATA) S DATA=0_DATA
|
|
K L,UUU Q
|
|
RTS ;Remove trailing spaces
|
|
Q:$E(DATA,$L(DATA))'=" "
|
|
F SLOOP=$L(DATA):-1 Q:$E(DATA,SLOOP)'=" " S DATA=$E(DATA,1,SLOOP-1)
|
|
K SLOOP Q
|
|
OT ;Output trans
|
|
Q:Y="" S IEN454=0,IEN454=$O(^PRSP(454,1,SUB454,"B",Y,IEN454))
|
|
I IEN454>0,$P(^PRSP(454,1,SUB454,IEN454,0),U,2)'="" S Y=$P(^PRSP(454,1,SUB454,IEN454,0),U,2) I SUB454="ORG",$D(^PRSP(454.1,Y,0)) S Y=$P(^PRSP(454.1,Y,0),U,1)
|
|
K IEN454,SUB454 Q
|
|
SOT ;State
|
|
Q:Y=""
|
|
S IEN5=0,IEN5=$O(^DIC(5,"C",Y,IEN5))
|
|
S Y=$S(IEN5>0:$P(^DIC(5,IEN5,0),U,1),1:Y)
|
|
K IEN5 Q
|
|
AC ;Asgmnt code
|
|
Q:Y=""
|
|
S AC="",AC1="",OSC=$E($P(^PRSPC(D0,0),U,17),1,4)
|
|
F LLL=0:0 S LLL=$O(^PRSP(454,1,"ASS","B",Y,LLL)) Q:LLL="" D Q:AC'=""
|
|
.S OCCS=$P(^PRSP(454,1,"ASS",LLL,0),U,3)
|
|
.I OCCS="" S AC1=$P(^PRSP(454,1,"ASS",LLL,0),"^",2)
|
|
.I OCCS[OSC S AC=$P(^PRSP(454,1,"ASS",LLL,0),"^",2)
|
|
S Y=$S(AC'="":AC,1:AC1)
|
|
K AC,AC1,LLL,OCCS,OSC Q
|
|
TITLE ;Title
|
|
I DATA=" " S DATA="" Q
|
|
S LD=$E(DATA,6) S:LD'?1N $P(^PRSPC(IEN,0),U,42)=LD
|
|
I $P(^PRSPC(IEN,0),U,42)?1U&(LD?1N) S $P(^PRSPC(IEN,0),U,42)=""
|
|
K LD Q
|
|
NH ;Norm Hrs
|
|
S DATA=+DATA,DB=$P(^PRSPC(IEN,0),U,10)
|
|
S NH=$S(DATA>0:DATA,DB=1:80,DB=2:DATA,DB=3:0,1:0)
|
|
S $P(^PRSPC(IEN,0),U,50)=NH
|
|
K DB,NH Q
|
|
STEP ;Step
|
|
I DATA=" " S DATA="" Q
|
|
S:$E(DATA,1)=" " DATA=$E(DATA,2) Q
|
|
ORGCC ;Org/Cost Cntr
|
|
I DBNAME="MXORGCOD" S COST=$E(DATA,1,4),$P(^PRSPC(IEN,0),U,18)=COST
|
|
S CCORG=$E(DATA,1,4)_":"_$E(DATA,5,8)
|
|
I '$D(^PRSP(454,1,"ORG","B",CCORG)) K DD,DO S DIC="^PRSP(454,1,""ORG"",",DIC(0)="L",DLAYGO=454,X=CCORG D FILE^DICN S ^TMP($J,"ORG",CCORG)=""
|
|
K COST,CCORG,DIC,DLAYGO,X Q
|
|
PVAE ;Prior VA Exp
|
|
F ABC=1:1:$L(DATA) S PV=$E(DATA,ABC),PIECE=$S(PV="A":1,PV="B":2,PV="C":3,PV="D":4,PV="E":5,PV="F":6,PV="G":7,PV="H":8,PV="I":9,PV="J":10,PV="K":11,PV="L":12,PV="M":13,PV=0:ABC,1:"") S:PIECE'="" $P(^PRSPC(IEN,NODE),U,PIECE)=PV
|
|
K ABC,PV Q
|
|
ZIP ;Zip
|
|
I +DATA=0 S DATA="" Q
|
|
I $E(DATA,6,9)="0000" S DATA=$E(DATA,1,5) Q
|
|
S DATA=$E(DATA,1,5)_"-"_$E(DATA,6,9) Q
|
|
NPLWOP ;Nonpay & LWOP Hrs
|
|
S LVGRP=$P(^PRSPC(IEN,0),U,15)
|
|
S NPLWOP=$S((LVGRP=4)!(LVGRP=5):$J((DATA/14)*80,1,0),1:DATA)
|
|
I DBNAME="ANONPATIME" S $P(^PRSPC(IEN,1),U,43)=NPLWOP S:TYPE="P" $P(^PRST(459,PPIEN,"P",IEN,6),U,5)=NPLWOP
|
|
I DBNAME="ALWOPUSED" S $P(^PRSPC(IEN,"LWOP"),U,11)=NPLWOP S:TYPE="P" $P(^PRST(459,PPIEN,"P",IEN,4),U,9)=NPLWOP
|
|
K LVGRP,NPLWOP Q
|
|
NEWSSN ;New SSN
|
|
I $L(DATA)<9 S L=9 D LZ
|
|
Q
|
|
COMP ;0 out comp time bal
|
|
I DATA="",$E(^PRSPC(IEN,"COMP"),1,7)="^^^^^^^",$P(^PRSPC(IEN,"COMP"),U,9)'="" F ABC=9:1:17 S $P(^PRSPC(IEN,"COMP"),U,ABC)=""
|
|
Q
|
|
OST ;Occupation Series & Title Output Transform
|
|
S OSC=Y,OSC14=$E(Y,1,4),OSC15=$E(Y,1,5),LD=$E(Y,6)
|
|
G:LD?1N OSTOT
|
|
I OSC14<2200 S NLD=$S((LD="A")!(LD="J"):1,(LD="B")!(LD="K"):2,(LD="C")!(LD="L"):3,(LD="D")!(LD="M"):4,(LD="E")!(LD="N"):5,(LD="F")!(LD="O"):6,(LD="G")!(LD="P"):7,(LD="H")!(LD="Q"):8,(LD="I")!(LD="R"):9,1:LD) S Y=OSC15_NLD
|
|
I OSC14>2600,LD'?1N S Y=OSC15_"0"
|
|
OSTOT S SUB454="OCC" D OT^PRSDUTIL K SUB454
|
|
I OSC14<2200,(LD="A")!(LD="B")!(LD="C")!(LD="D")!(LD="E")!(LD="F")!(LD="G")!(LD="H")!(LD="I") S:(Y'["OFFICER")!(Y="POLICE OFFICER") Y="SUPERVISORY "_Y G OSTEX
|
|
I OSC14<2200,(LD="J")!(LD="K")!(LD="L")!(LD="M")!(LD="N")!(LD="O")!(LD="P")!(LD="Q")!(LD="R") S Y="LEAD "_Y G OSTEX
|
|
I OSC14>2600,(LD="F")!(LD="G")!(LD="H")!(LD="L")!(LD="S") S SUF=$S(LD="H":" HELPER",LD="L":" LEADER",LD="F":" FOREMAN",LD="G":" GENERAL FOREMAN",LD="S":" SUPERVISOR",1:LD),Y=Y_SUF
|
|
OSTEX K OSC,OSC14,OSC15,LD,NLD,SUF
|
|
Q
|
|
;
|
|
LD ; Set Labor Distribution fields into Multiple.
|
|
N PRSTMP
|
|
S PRSTMP=DATA,DATA=$E(DATA,1,4)
|
|
D LD^PRSDSET
|
|
S DATA=PRSTMP
|
|
Q
|
|
;==============================================================
|
|
PATCH32 ;Subprograms LOOP450 and DTCMP are post-installation routines
|
|
;for patch PRS*4*32. They have no other intended use.
|
|
;Convert fields that have received year 2000 dates from Austin.
|
|
;Loop thru all employee records. Within employee records loop thru
|
|
;the 9 nodes (see ND variable) in each record that contain potential
|
|
;problem dates. Traverse the up arrow delimited data in each node,
|
|
;but only check the pieces defined in the CHECK array nodes.
|
|
;Convert dates in those fields that fall between jan 01, 1900 and
|
|
;DEC 31, 1910 inclusively. The conversion will only change the
|
|
;century to the 21st.
|
|
;
|
|
;
|
|
Q
|
|
;==============================================================
|
|
LOOP450 ;
|
|
;
|
|
;****Keep post-installation from running on subsequent patch installs
|
|
I $$PATCH^XPDUTL("PRS*4.0*32") D MSSG(0) Q
|
|
;
|
|
D MSSG(1)
|
|
N CHECK,ND,REC,PIECES,XPDIDTOT,DIV,%
|
|
S CHECK(0)="51^"
|
|
S CHECK(1)="30^"
|
|
S CHECK(2)="2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^20^22^23^24^25^26^27^28^29^30^31^32^"
|
|
S CHECK(3)="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^19^20^21^22^"
|
|
S CHECK(4)="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^19^20^"
|
|
S CHECK("PCD")="4^"
|
|
S CHECK("MSD2")="9^"
|
|
S CHECK("BOND1")="12^"
|
|
S CHECK("BOND2")="11^"
|
|
S CHECK("TSP1")="5^12^14^"
|
|
;
|
|
S XPDIDTOT=$P($G(^PRSPC(0)),"^",4)
|
|
S DIV=XPDIDTOT\20
|
|
S %=0
|
|
S REC=0 F S REC=$O(^PRSPC(REC)) Q:REC'>0 D
|
|
. S %=%+1
|
|
. I '(%#DIV) D UPDATE^XPDID(%)
|
|
. S ND=""
|
|
. F S ND=$O(CHECK(ND)) Q:ND="" D
|
|
.. I $G(^PRSPC(REC,ND))'="" D
|
|
... S PIECES=CHECK(ND)
|
|
... D DTCMP(REC,ND,$G(^PRSPC(REC,ND)),PIECES)
|
|
Q
|
|
;==============================================================
|
|
DTCMP(IEN,NODE,DATANODE,PIECES) ;
|
|
;Look at all PEICES in a single DATANODE of an employee's record
|
|
;and convert dates from 1900-1910 to respective dates in 2000-2010.
|
|
N PIECE,NEXT,NEWDATE,DATA
|
|
F NEXT=1:1 S PIECE=$P(PIECES,"^",NEXT) Q:PIECE="" D
|
|
. S DATA=$P(DATANODE,"^",PIECE)
|
|
. I (DATA<2110101),(DATA>1991231) D
|
|
.. S NEWDATE="3"_$E(DATA,2,7)
|
|
.. S $P(^PRSPC(IEN,NODE),"^",PIECE)=NEWDATE
|
|
Q
|
|
;==============================================================
|
|
MSSG(FLAG) ;OUT PUT POST INSTALLATION MESSAGE.
|
|
N MSSG
|
|
I FLAG S MSSG="Checking date fields in File 450."
|
|
E S MSSG="Date fields not checked. Checked during previous install of PRS*4*32"
|
|
D MES^XPDUTL(MSSG)
|
|
Q
|
|
;==============================================================
|