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