PRSASAL ; HISC/REL-Supervisor Alert Utilities ;5/31/95 14:01
;;4.0;PAID;;Sep 21, 1995
AL ; Check for Alerts
G:'$D(^PRST(455.5,"AS",DUZ)) A1
N X1,X2 F X1=0:0 S X1=$O(^PRST(455.5,"AS",DUZ,X1)) Q:X1<1 D
.S X2=$G(^PRST(455.5,X1,0)) Q:'$P(X2,"^",10)
.S MSG="!T&L "_$P(X2,"^",1)_" has "_$P(X2,"^",10)_" actions to certify." D SET^XUS1A(MSG) Q
A1 Q:'$D(^PRST(455.5,"AA",DUZ))
N X1,X2 S X2=0 F X1=0:0 S X1=$O(^PRST(455.5,"AA",DUZ,X1)) Q:X1<1 D
.S X2=X2+$P($G(^PRST(455.5,X1,0)),"^",11) Q
I X2 S MSG="!PAID has "_X2_" OT/CT/Prior Pay Period actions to approve." D SET^XUS1A(MSG)
Q
UPD ; Update T&L Pending count
N DA,NN,NUM,DFN,PPI,SSN S NUM=0
S NN="",CKS=1 F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 D CHK
S CKS=0 F VA2=0:0 S VA2=$O(^PRST(455.5,"ASX",TLE,VA2)) Q:VA2<1 S SSN=$P($G(^VA(200,VA2,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)) I DFN,$P($G(^PRSPC(+DFN,0)),"^",8)'=TLE D CHK
S $P(^PRST(455.5,TLI,0),"^",10)=NUM Q
CHK ; Check for needed approvals
I CKS S SSN=$P($G(^PRSPC(DFN,0)),"^",9) I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) Q:$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE
F DA=0:0 S DA=$O(^PRST(458.1,"AR",DFN,DA)) Q:DA<1 S NUM=NUM+1
F DA=0:0 S DA=$O(^PRST(458.2,"AR",DFN,DA)) Q:DA<1 S NUM=NUM+1
F DA=0:0 S DA=$O(^PRST(458.3,"AR",DFN,DA)) Q:DA<1 S NUM=NUM+1
I $D(^PRST(458,"ATC",DFN)) F PPI=0:0 S PPI=$O(^PRST(458,"ATC",DFN,PPI)) Q:PPI<1 S NUM=NUM+1
I $D(^PRST(458,"AXR",DFN)) F PPI=0:0 S PPI=$O(^PRST(458,"AXR",DFN,PPI)) Q:PPI<1 F AUN=0:0 S AUN=$O(^PRST(458,"AXR",DFN,PPI,AUN)) Q:AUN<1 S NUM=NUM+1
Q
APP ; Update T&L Approval Count
N DA,NN,NUM,DFN,PPI,AUN S NUM=0
S NN="" F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 I $D(^PRST(458.2,"AS",DFN)) D
.F DA=0:0 S DA=$O(^PRST(458.2,"AS",DFN,DA)) Q:DA<1 S NUM=NUM+1
.Q
F DFN=0:0 S DFN=$O(^PRST(458,"AXS",DFN)) Q:DFN<1 F PPI=0:0 S PPI=$O(^PRST(458,"AXS",DFN,PPI)) Q:PPI<1 D
.I $E($G(^PRST(458,PPI,"E",DFN,5)),22,24)'=TLE Q
.F AUN=0:0 S AUN=$O(^PRST(458,"AXS",DFN,PPI,AUN)) Q:AUN<1 S NUM=NUM+1
.Q
S $P(^PRST(455.5,TLI,0),"^",11)=NUM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSASAL 2202 printed Oct 16, 2024@18:25 Page 2
PRSASAL ; HISC/REL-Supervisor Alert Utilities ;5/31/95 14:01
+1 ;;4.0;PAID;;Sep 21, 1995
AL ; Check for Alerts
+1 if '$DATA(^PRST(455.5,"AS",DUZ))
GOTO A1
+2 NEW X1,X2
FOR X1=0:0
SET X1=$ORDER(^PRST(455.5,"AS",DUZ,X1))
if X1<1
QUIT
Begin DoDot:1
+3 SET X2=$GET(^PRST(455.5,X1,0))
if '$PIECE(X2,"^",10)
QUIT
+4 SET MSG="!T&L "_$PIECE(X2,"^",1)_" has "_$PIECE(X2,"^",10)_" actions to certify."
DO SET^XUS1A(MSG)
QUIT
End DoDot:1
A1 if '$DATA(^PRST(455.5,"AA",DUZ))
QUIT
+1 NEW X1,X2
SET X2=0
FOR X1=0:0
SET X1=$ORDER(^PRST(455.5,"AA",DUZ,X1))
if X1<1
QUIT
Begin DoDot:1
+2 SET X2=X2+$PIECE($GET(^PRST(455.5,X1,0)),"^",11)
QUIT
End DoDot:1
+3 IF X2
SET MSG="!PAID has "_X2_" OT/CT/Prior Pay Period actions to approve."
DO SET^XUS1A(MSG)
+4 QUIT
UPD ; Update T&L Pending count
+1 NEW DA,NN,NUM,DFN,PPI,SSN
SET NUM=0
+2 SET NN=""
SET CKS=1
FOR
SET NN=$ORDER(^PRSPC("ATL"_TLE,NN))
if NN=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC("ATL"_TLE,NN,DFN))
if DFN<1
QUIT
DO CHK
+3 SET CKS=0
FOR VA2=0:0
SET VA2=$ORDER(^PRST(455.5,"ASX",TLE,VA2))
if VA2<1
QUIT
SET SSN=$PIECE($GET(^VA(200,VA2,1)),"^",9)
IF SSN'=""
SET DFN=$ORDER(^PRSPC("SSN",SSN,0))
IF DFN
IF $PIECE($GET(^PRSPC(+DFN,0)),"^",8)'=TLE
DO CHK
+4 SET $PIECE(^PRST(455.5,TLI,0),"^",10)=NUM
QUIT
CHK ; Check for needed approvals
+1 IF CKS
SET SSN=$PIECE($GET(^PRSPC(DFN,0)),"^",9)
IF SSN
SET EDUZ=+$ORDER(^VA(200,"SSN",SSN,0))
IF $DATA(^PRST(455.5,"AS",EDUZ,TLI))
if $PIECE($GET(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)'=TLE
QUIT
+2 FOR DA=0:0
SET DA=$ORDER(^PRST(458.1,"AR",DFN,DA))
if DA<1
QUIT
SET NUM=NUM+1
+3 FOR DA=0:0
SET DA=$ORDER(^PRST(458.2,"AR",DFN,DA))
if DA<1
QUIT
SET NUM=NUM+1
+4 FOR DA=0:0
SET DA=$ORDER(^PRST(458.3,"AR",DFN,DA))
if DA<1
QUIT
SET NUM=NUM+1
+5 IF $DATA(^PRST(458,"ATC",DFN))
FOR PPI=0:0
SET PPI=$ORDER(^PRST(458,"ATC",DFN,PPI))
if PPI<1
QUIT
SET NUM=NUM+1
+6 IF $DATA(^PRST(458,"AXR",DFN))
FOR PPI=0:0
SET PPI=$ORDER(^PRST(458,"AXR",DFN,PPI))
if PPI<1
QUIT
FOR AUN=0:0
SET AUN=$ORDER(^PRST(458,"AXR",DFN,PPI,AUN))
if AUN<1
QUIT
SET NUM=NUM+1
+7 QUIT
APP ; Update T&L Approval Count
+1 NEW DA,NN,NUM,DFN,PPI,AUN
SET NUM=0
+2 SET NN=""
FOR
SET NN=$ORDER(^PRSPC("ATL"_TLE,NN))
if NN=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC("ATL"_TLE,NN,DFN))
if DFN<1
QUIT
IF $DATA(^PRST(458.2,"AS",DFN))
Begin DoDot:1
+3 FOR DA=0:0
SET DA=$ORDER(^PRST(458.2,"AS",DFN,DA))
if DA<1
QUIT
SET NUM=NUM+1
+4 QUIT
End DoDot:1
+5 FOR DFN=0:0
SET DFN=$ORDER(^PRST(458,"AXS",DFN))
if DFN<1
QUIT
FOR PPI=0:0
SET PPI=$ORDER(^PRST(458,"AXS",DFN,PPI))
if PPI<1
QUIT
Begin DoDot:1
+6 IF $EXTRACT($GET(^PRST(458,PPI,"E",DFN,5)),22,24)'=TLE
QUIT
+7 FOR AUN=0:0
SET AUN=$ORDER(^PRST(458,"AXS",DFN,PPI,AUN))
if AUN<1
QUIT
SET NUM=NUM+1
+8 QUIT
End DoDot:1
+9 SET $PIECE(^PRST(455.5,TLI,0),"^",11)=NUM
QUIT
