- 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 Feb 18, 2025@23:50:47 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