| [628] | 1 | PRSATL ; HISC/REL-Edit/Display T&L Unit ;3/4/1998
|
|---|
| 2 | ;;4.0;PAID;**38**;Sep 21, 1995
|
|---|
| 3 | EDIT ; Enter/Edit T&L Unit
|
|---|
| 4 | D HDR K DIC
|
|---|
| 5 | 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
|
|---|
| 6 | S DA=+Y,DDSFILE=455.5,DR="[PRSA TL EDIT]" D ^DDS K DS G EDIT
|
|---|
| 7 | DISP ; Display T&L Unit
|
|---|
| 8 | D HDR K DIC
|
|---|
| 9 | S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: " D ^DIC K DIC G:Y'>0 EX
|
|---|
| 10 | S DA=+Y,DDSFILE=455.5,DR="[PRSA TL DISP]" D ^DDS K DS G DISP
|
|---|
| 11 | EMP ; Change T&L for an Employee
|
|---|
| 12 | K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",(DIC,DIE)="^PRSPC(" W ! D ^DIC S DFN=+Y K DIC
|
|---|
| 13 | I DFN<1 G EX
|
|---|
| 14 | S OLD=$P($G(^PRSPC(DFN,0)),"^",8)
|
|---|
| 15 | S DA=DFN,DR=7 D ^DIE I $P($G(^PRSPC(DFN,0)),"^",8)=OLD G EMP
|
|---|
| 16 | S PPI=$P(^PRST(458,0),"^",3)
|
|---|
| 17 | 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
|
|---|
| 18 | S PPI=PPI-1
|
|---|
| 19 | I $P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)="P" K ^(5) D ONE^PRS8 S ^PRST(458,PPI,"E",DFN,5)=VAL
|
|---|
| 20 | G EMP
|
|---|
| 21 | SUP ; Set ASX cross-reference for Supervisor (Obsolete with PRS*4*38)
|
|---|
| 22 | ;S SSN=$P($G(^VA(200,DA,1)),"^",9),STL=""
|
|---|
| 23 | ;I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0)),STL=$P($G(^PRSPC(+DFN,0)),"^",8)
|
|---|
| 24 | ;F I9=0:0 S I9=$O(^PRST(455.5,"AS",DA,I9)) Q:I9<1 I DA(1)'=I9 D
|
|---|
| 25 | ;.S CTL=$P($G(^PRST(455.5,I9,"S",DA,0)),"^",2)
|
|---|
| 26 | ;.I CTL'="",CTL'=STL,'$D(^PRST(455.5,"ASX",CTL,DA)) S ^PRST(455.5,"ASX",CTL,DA)=""
|
|---|
| 27 | ;.Q
|
|---|
| 28 | ;I X'=STL,'$D(^PRST(455.5,"ASX",X,DA)) S ^PRST(455.5,"ASX",X,DA)=""
|
|---|
| 29 | Q
|
|---|
| 30 | ASX ; List ASX Entries and re-index
|
|---|
| 31 | S PRSTLV=7 D ^PRSAUTL I TLI<1 G EX
|
|---|
| 32 | W !!,"Employees outside of this T&L who are Certified by this T&L:",!
|
|---|
| 33 | S (CNT,DA)=0 F S DA=$O(^PRST(455.5,"ASX",TLE,DA)) Q:'DA D
|
|---|
| 34 | . S SSN=$P($G(^VA(200,DA,1)),U,9) Q:SSN=""
|
|---|
| 35 | . S DFN=$O(^PRSPC("SSN",SSN,0)) Q:'DFN
|
|---|
| 36 | . Q:$P($G(^PRSPC(DFN,0)),U,8)=TLE ; don't list if user in T&L
|
|---|
| 37 | . W !,?4,$P($G(^VA(200,DA,0)),U,1)
|
|---|
| 38 | . S CNT=CNT+1
|
|---|
| 39 | W:'CNT !," No Employees outside of this T&L are Certified by this T&L."
|
|---|
| 40 | W ! S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
|
|---|
| 41 | ; the following lines have been commented out by patch PRS*4*38. The
|
|---|
| 42 | ; x-ref should not be casually deleted since certification and approval
|
|---|
| 43 | ; options rely on its existance.
|
|---|
| 44 | ; If necessary IRM can rebuild x-ref via FileMan options.
|
|---|
| 45 | ;K DIR S DIR("A")="Do you wish to Re-Build this Index? ",DIR(0)="YA"
|
|---|
| 46 | ;S DIR("B")="No" W ! D ^DIR K DIR G:'Y EX
|
|---|
| 47 | ;K ^PRST(455.5,"ASX")
|
|---|
| 48 | ; loop thru T&Ls
|
|---|
| 49 | ;S DA(1)=0 F S DA(1)=$O(^PRST(455.5,DA(1))) Q:'DA(1) D
|
|---|
| 50 | ;. S DIK="^PRST(455.5,"_DA(1)_",""S"",",DIK(1)="1^ASX"
|
|---|
| 51 | ;. D ENALL^DIK ; rebuilds xref for all entries in supervisor subfile
|
|---|
| 52 | K CNT,DA,DFN,DIK,DIR,SSN,TLE,TLI
|
|---|
| 53 | Q
|
|---|
| 54 | HDR ; Header
|
|---|
| 55 | W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!!?31,"TIME & LEAVE UNIT",!!! Q
|
|---|
| 56 | EX G KILL^XUSCLEAN
|
|---|
