PRSAEDR ;HISC/REL-Environmental Diff. Requests ;12-SEP-00
;;4.0;PAID;**61**;Sep 21, 1995
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
E1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC G:DFN<1 EX
D ^PRSAENT I $E(ENT,15,16)'["1" W !!?5,"This employee is not entitled to Hazard or Environment Differential" G E1
S ZENT=$S($E(ENT,15):"H",$E(ENT,16):"E",1:"")
L +^PRST(458.3,0) K DDSFILE,DA,DR
N1 S DA=$P(^PRST(458.3,0),"^",3)+1 I $D(^PRST(458.3,DA)) S $P(^PRST(458.3,0),"^",3)=DA G N1
S $P(^PRST(458.3,0),"^",3)=DA,$P(^(0),"^",4)=$P(^(0),"^",4)+1 L -^PRST(458.3,0)
S ^PRST(458.3,DA,0)=DA_"^"_DFN,^PRST(458.3,"B",DA,DA)="",^PRST(458.3,"C",DFN,DA)=""
S DDSFILE=458.3,DR="[PRSA ED REQ]" D ^DDS K DS
S %=$P(^PRST(458.3,DA,0),"^",3) I '% S DIK="^PRST(458.3," D ^DIK K DIK G EX
D NOW^%DTC S $P(^PRST(458.3,DA,0),"^",9,11)="R^"_DUZ_"^"_%,^PRST(458.3,"AR",DFN,DA)=""
D UPD^PRSASAL G EX
VAL ; Validate request
Q:'$D(Z1) S X=$P(Z1,"^",2)_"^"_$P(Z1,"^",4) D CNV^PRSATIM
S Z2=$P(Y,"^",1),Z4=$P(Y,"^",2)
I Z2'<Z4 S STR="Start time must be less than ending time." G V1
I Z4-Z2-$P(Z1,"^",3)'>0 S STR="Total time (End-Start-Meal) is not greater than 0." G V1
I '$D(^PRST(458,"AD",+$P(Z1,"^",1))) S STR="Pay Period not established for that date." G V1
Q
V1 S DDSERROR=1 D HLP^DDSUTL(.STR) Q
CAN ; Cancel ED Request
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
I DFN<1 G EX
D HDR^PRSAEDS
K %DT S %DT="AEPX",%DT("A")="Begin with Date: ",%DT("B")="T",%DT(0)=-DT W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=9999999-Y
W ! S NUM=1 D DISP^PRSAEDS
G:'CNT EX
X1 R !!,"Cancel Which Request #? ",X:DTIME G:'$T!("^"[X) EX I X'?1N.N!(X<1)!(X>CNT) W *7," Enter # of Request to Cancel" G X1
S X=+X,DA=R(X),$P(^PRST(458.3,DA,0),"^",9)="X" K ^PRST(458.3,"AR",DFN,DA)
D UPD^PRSASAL W " ... done"
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAEDR 2049 printed Nov 22, 2024@17:33:28 Page 2
PRSAEDR ;HISC/REL-Environmental Diff. Requests ;12-SEP-00
+1 ;;4.0;PAID;**61**;Sep 21, 1995
+2 SET PRSTLV=2
DO ^PRSAUTL
if TLI<1
GOTO EX
E1 KILL DIC
SET DIC("A")="Select EMPLOYEE: "
SET DIC("S")="I $P(^(0),""^"",8)=TLE"
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
SET D="ATL"_TLE
WRITE !
DO IX^DIC
SET DFN=+Y
KILL DIC
if DFN<1
GOTO EX
+1 DO ^PRSAENT
IF $EXTRACT(ENT,15,16)'["1"
WRITE !!?5,"This employee is not entitled to Hazard or Environment Differential"
GOTO E1
+2 SET ZENT=$SELECT($EXTRACT(ENT,15):"H",$EXTRACT(ENT,16):"E",1:"")
+3 LOCK +^PRST(458.3,0)
KILL DDSFILE,DA,DR
N1 SET DA=$PIECE(^PRST(458.3,0),"^",3)+1
IF $DATA(^PRST(458.3,DA))
SET $PIECE(^PRST(458.3,0),"^",3)=DA
GOTO N1
+1 SET $PIECE(^PRST(458.3,0),"^",3)=DA
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
LOCK -^PRST(458.3,0)
+2 SET ^PRST(458.3,DA,0)=DA_"^"_DFN
SET ^PRST(458.3,"B",DA,DA)=""
SET ^PRST(458.3,"C",DFN,DA)=""
+3 SET DDSFILE=458.3
SET DR="[PRSA ED REQ]"
DO ^DDS
KILL DS
+4 SET %=$PIECE(^PRST(458.3,DA,0),"^",3)
IF '%
SET DIK="^PRST(458.3,"
DO ^DIK
KILL DIK
GOTO EX
+5 DO NOW^%DTC
SET $PIECE(^PRST(458.3,DA,0),"^",9,11)="R^"_DUZ_"^"_%
SET ^PRST(458.3,"AR",DFN,DA)=""
+6 DO UPD^PRSASAL
GOTO EX
VAL ; Validate request
+1 if '$DATA(Z1)
QUIT
SET X=$PIECE(Z1,"^",2)_"^"_$PIECE(Z1,"^",4)
DO CNV^PRSATIM
+2 SET Z2=$PIECE(Y,"^",1)
SET Z4=$PIECE(Y,"^",2)
+3 IF Z2'<Z4
SET STR="Start time must be less than ending time."
GOTO V1
+4 IF Z4-Z2-$PIECE(Z1,"^",3)'>0
SET STR="Total time (End-Start-Meal) is not greater than 0."
GOTO V1
+5 IF '$DATA(^PRST(458,"AD",+$PIECE(Z1,"^",1)))
SET STR="Pay Period not established for that date."
GOTO V1
+6 QUIT
V1 SET DDSERROR=1
DO HLP^DDSUTL(.STR)
QUIT
CAN ; Cancel ED Request
+1 SET PRSTLV=2
DO ^PRSAUTL
if TLI<1
GOTO EX
+2 KILL DIC
SET DIC("A")="Select EMPLOYEE: "
SET DIC("S")="I $P(^(0),""^"",8)=TLE"
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
SET D="ATL"_TLE
WRITE !
DO IX^DIC
SET DFN=+Y
KILL DIC
+3 IF DFN<1
GOTO EX
+4 DO HDR^PRSAEDS
+5 KILL %DT
SET %DT="AEPX"
SET %DT("A")="Begin with Date: "
SET %DT("B")="T"
SET %DT(0)=-DT
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET EDT=9999999-Y
+6 WRITE !
SET NUM=1
DO DISP^PRSAEDS
+7 if 'CNT
GOTO EX
X1 READ !!,"Cancel Which Request #? ",X:DTIME
if '$TEST!("^"[X)
GOTO EX
IF X'?1N.N!(X<1)!(X>CNT)
WRITE *7," Enter # of Request to Cancel"
GOTO X1
+1 SET X=+X
SET DA=R(X)
SET $PIECE(^PRST(458.3,DA,0),"^",9)="X"
KILL ^PRST(458.3,"AR",DFN,DA)
+2 DO UPD^PRSASAL
WRITE " ... done"
EX GOTO KILL^XUSCLEAN