PRSAOTR ;HISC/REL-OT/CT Request/Cancel ;12-SEP-00
;;4.0;PAID;**2,34,61,151**;Sep 21, 1995;Build 2
;Per VA Directive 6402, this routine should not be modified
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
O1 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 S ZENT=$S($E(ENT,12):"OT",1:"")_" "_$S($E(ENT,28):"CT",1:"")
I ZENT=" " W !!?5,"This Employee is Not Entitled to Either OT or CT/CH" G O1
O2 L +^PRST(458.2,0):$G(DILOCKTM,3) K DDSFILE,DA,DR
N1 S DA=$P(^PRST(458.2,0),"^",3)+1 I $D(^PRST(458.2,DA)) S $P(^PRST(458.2,0),"^",3)=DA G N1
S $P(^PRST(458.2,0),"^",3)=DA,$P(^(0),"^",4)=$P(^(0),"^",4)+1 L -^PRST(458.2,0)
S ^PRST(458.2,DA,0)=DA_"^"_DFN_"^^^^^^^"_TLE,^PRST(458.2,"B",DA,DA)="",^PRST(458.2,"C",DFN,DA)="" ;Pass T&L Unit Into ScreenMan API, PRS*4*151
S DDSFILE=458.2,DR="[PRSA OT REQ]" D ^DDS K DS
S %=$P(^PRST(458.2,DA,0),"^",3) I '% S DIK="^PRST(458.2," D ^DIK K DIK G EX
D NOW^%DTC S $P(^PRST(458.2,DA,0),"^",8)="R",$P(^(0),"^",11,12)=DUZ_"^"_%,^PRST(458.2,"AR",DFN,DA)=""
S X=$P($G(^PRSPC(DFN,0)),"^",29) I X S:X>100 X=X/2080 S $P(^PRST(458.2,DA,0),"^",10)=+$J(X*1.5*$P(^PRST(458.2,DA,0),"^",6),0,2)
D UPD^PRSASAL G O1
CAN ; Cancel OT 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^PRSAOTS
K %DT S %DT="AEFX",%DT("A")="Begin with Date: ",%DT("B")="T" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S DTI=Y
S NUM=1 D DISP^PRSAOTS
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.2,DA,0),"^",8)="X" K ^PRST(458.2,"AR",DFN,DA),^PRST(458.2,"AS",DFN,DA)
D UPD^PRSASAL W " ... done"
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAOTR 1922 printed Dec 13, 2024@02:23:44 Page 2
PRSAOTR ;HISC/REL-OT/CT Request/Cancel ;12-SEP-00
+1 ;;4.0;PAID;**2,34,61,151**;Sep 21, 1995;Build 2
+2 ;Per VA Directive 6402, this routine should not be modified
+3 SET PRSTLV=2
DO ^PRSAUTL
if TLI<1
GOTO EX
O1 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
SET ZENT=$SELECT($EXTRACT(ENT,12):"OT",1:"")_" "_$SELECT($EXTRACT(ENT,28):"CT",1:"")
+2 IF ZENT=" "
WRITE !!?5,"This Employee is Not Entitled to Either OT or CT/CH"
GOTO O1
O2 LOCK +^PRST(458.2,0):$GET(DILOCKTM,3)
KILL DDSFILE,DA,DR
N1 SET DA=$PIECE(^PRST(458.2,0),"^",3)+1
IF $DATA(^PRST(458.2,DA))
SET $PIECE(^PRST(458.2,0),"^",3)=DA
GOTO N1
+1 SET $PIECE(^PRST(458.2,0),"^",3)=DA
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
LOCK -^PRST(458.2,0)
+2 ;Pass T&L Unit Into ScreenMan API, PRS*4*151
SET ^PRST(458.2,DA,0)=DA_"^"_DFN_"^^^^^^^"_TLE
SET ^PRST(458.2,"B",DA,DA)=""
SET ^PRST(458.2,"C",DFN,DA)=""
+3 SET DDSFILE=458.2
SET DR="[PRSA OT REQ]"
DO ^DDS
KILL DS
+4 SET %=$PIECE(^PRST(458.2,DA,0),"^",3)
IF '%
SET DIK="^PRST(458.2,"
DO ^DIK
KILL DIK
GOTO EX
+5 DO NOW^%DTC
SET $PIECE(^PRST(458.2,DA,0),"^",8)="R"
SET $PIECE(^(0),"^",11,12)=DUZ_"^"_%
SET ^PRST(458.2,"AR",DFN,DA)=""
+6 SET X=$PIECE($GET(^PRSPC(DFN,0)),"^",29)
IF X
if X>100
SET X=X/2080
SET $PIECE(^PRST(458.2,DA,0),"^",10)=+$JUSTIFY(X*1.5*$PIECE(^PRST(458.2,DA,0),"^",6),0,2)
+7 DO UPD^PRSASAL
GOTO O1
CAN ; Cancel OT 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^PRSAOTS
+5 KILL %DT
SET %DT="AEFX"
SET %DT("A")="Begin with Date: "
SET %DT("B")="T"
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET DTI=Y
+6 SET NUM=1
DO DISP^PRSAOTS
+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.2,DA,0),"^",8)="X"
KILL ^PRST(458.2,"AR",DFN,DA),^PRST(458.2,"AS",DFN,DA)
+2 DO UPD^PRSASAL
WRITE " ... done"
EX GOTO KILL^XUSCLEAN
