57 lines
2.6 KiB
Mathematica
57 lines
2.6 KiB
Mathematica
|
PRSATL ; HISC/REL-Edit/Display T&L Unit ;3/4/1998
|
||
|
|
;;4.0;PAID;**38**;Sep 21, 1995
|
||
|
|
EDIT ; Enter/Edit T&L Unit
|
||
|
|
D HDR K DIC
|
||
|
|
S DIC="^PRST(455.5,",DIC(0)="AEQLM",DLAYGO=455.5,DIC("A")="Select T&L Unit: " D ^DIC K DIC G:Y'>0 EX
|
||
|
|
S DA=+Y,DDSFILE=455.5,DR="[PRSA TL EDIT]" D ^DDS K DS G EDIT
|
||
|
|
DISP ; Display T&L Unit
|
||
|
|
D HDR K DIC
|
||
|
|
S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: " D ^DIC K DIC G:Y'>0 EX
|
||
|
|
S DA=+Y,DDSFILE=455.5,DR="[PRSA TL DISP]" D ^DDS K DS G DISP
|
||
|
|
EMP ; Change T&L for an Employee
|
||
|
|
K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",(DIC,DIE)="^PRSPC(" W ! D ^DIC S DFN=+Y K DIC
|
||
|
|
I DFN<1 G EX
|
||
|
|
S OLD=$P($G(^PRSPC(DFN,0)),"^",8)
|
||
|
|
S DA=DFN,DR=7 D ^DIE I $P($G(^PRSPC(DFN,0)),"^",8)=OLD G EMP
|
||
|
|
S PPI=$P(^PRST(458,0),"^",3)
|
||
|
|
I $P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)="P" K ^(5) D ONE^PRS8 S ^PRST(458,PPI,"E",DFN,5)=VAL G EMP
|
||
|
|
S PPI=PPI-1
|
||
|
|
I $P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)="P" K ^(5) D ONE^PRS8 S ^PRST(458,PPI,"E",DFN,5)=VAL
|
||
|
|
G EMP
|
||
|
|
SUP ; Set ASX cross-reference for Supervisor (Obsolete with PRS*4*38)
|
||
|
|
;S SSN=$P($G(^VA(200,DA,1)),"^",9),STL=""
|
||
|
|
;I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)),STL=$P($G(^PRSPC(+DFN,0)),"^",8)
|
||
|
|
;F I9=0:0 S I9=$O(^PRST(455.5,"AS",DA,I9)) Q:I9<1 I DA(1)'=I9 D
|
||
|
|
;.S CTL=$P($G(^PRST(455.5,I9,"S",DA,0)),"^",2)
|
||
|
|
;.I CTL'="",CTL'=STL,'$D(^PRST(455.5,"ASX",CTL,DA)) S ^PRST(455.5,"ASX",CTL,DA)=""
|
||
|
|
;.Q
|
||
|
|
;I X'=STL,'$D(^PRST(455.5,"ASX",X,DA)) S ^PRST(455.5,"ASX",X,DA)=""
|
||
|
|
Q
|
||
|
|
ASX ; List ASX Entries and re-index
|
||
|
|
S PRSTLV=7 D ^PRSAUTL I TLI<1 G EX
|
||
|
|
W !!,"Employees outside of this T&L who are Certified by this T&L:",!
|
||
|
|
S (CNT,DA)=0 F S DA=$O(^PRST(455.5,"ASX",TLE,DA)) Q:'DA D
|
||
|
|
. S SSN=$P($G(^VA(200,DA,1)),U,9) Q:SSN=""
|
||
|
|
. S DFN=$O(^PRSPC("SSN",SSN,0)) Q:'DFN
|
||
|
|
. Q:$P($G(^PRSPC(DFN,0)),U,8)=TLE ; don't list if user in T&L
|
||
|
|
. W !,?4,$P($G(^VA(200,DA,0)),U,1)
|
||
|
|
. S CNT=CNT+1
|
||
|
|
W:'CNT !," No Employees outside of this T&L are Certified by this T&L."
|
||
|
|
W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
|
||
|
|
; the following lines have been commented out by patch PRS*4*38. The
|
||
|
|
; x-ref should not be casually deleted since certification and approval
|
||
|
|
; options rely on its existance.
|
||
|
|
; If necessary IRM can rebuild x-ref via FileMan options.
|
||
|
|
;K DIR S DIR("A")="Do you wish to Re-Build this Index? ",DIR(0)="YA"
|
||
|
|
;S DIR("B")="No" W ! D ^DIR K DIR G:'Y EX
|
||
|
|
;K ^PRST(455.5,"ASX")
|
||
|
|
; loop thru T&Ls
|
||
|
|
;S DA(1)=0 F S DA(1)=$O(^PRST(455.5,DA(1))) Q:'DA(1) D
|
||
|
|
;. S DIK="^PRST(455.5,"_DA(1)_",""S"",",DIK(1)="1^ASX"
|
||
|
|
;. D ENALL^DIK ; rebuilds xref for all entries in supervisor subfile
|
||
|
|
K CNT,DA,DFN,DIK,DIR,SSN,TLE,TLI
|
||
|
|
Q
|
||
|
|
HDR ; Header
|
||
|
|
W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!!?31,"TIME & LEAVE UNIT",!!! Q
|
||
|
|
EX G KILL^XUSCLEAN
|