PRSNCTL ;WOIFO/DWA - Edit T&L Unit POC Entry and Approval Personnel ;11/24/09
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
EDIT ; Enter/Edit POC Entry and Approval Personnel for a T&L Unit
N TEMPLATE,STOP S STOP=0
S TEMPLATE="[PRSN EDIT TL POC]"
F D Q:STOP>0
. D MAIN(.STOP,TEMPLATE)
;
Q
;
DISP ; Display T&L Unit
N TEMPLATE,STOP S STOP=0
S TEMPLATE="[PRSA TL DISP]"
F D Q:STOP>0
. D MAIN(.STOP,TEMPLATE)
;
Q
;
MAIN(STOP,T) ;
N TLI,DA,DDSFILE,DR,DS
S STOP=0
S TLI=$$INIT()
I TLI'>0 S STOP=1 Q
S DA=+TLI,DDSFILE=455.5,DR=T
D ^DDS K DS
Q
;
INIT() ;
D HDR
N DIC,X,Y,DUOUT,DTOUT
S DIC="^PRST(455.5,",DIC(0)="AEQLM",DIC("A")="Select T&L Unit: " D ^DIC K DIC
I $D(DUOUT)!$D(DTOUT)!(Y'>0) Q 0
Q Y
;
HDR ; Header
W:$E(IOST,1,2)="C-" @IOF
W !,?26,"VA TIME & ATTENDANCE SYSTEM",!
W ?24,"EDIT POC ENTRY & APPROVAL PERSONNEL",!
W ?36,"T&L UNIT",!!!
;
Q
;
TL2PEV ;OVERWRITE T&L TIMEKEEPERS AND SUPERVISORS TO PEV DATA ENTRY AND
;APPROVERS
;
;Prompt for T&L unit
;
N DIC,X,Y,DUOUT,DTOUT
S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: "
D ^DIC
Q:$D(DUOUT)!$D(DTOUT)!Y'>0
N TLIEN,ENIEN,SUIEN,APIEN,TKIEN,IENS,IEN,FDA,J,STOP,IEN450
S TLIEN=+Y
;
D HDR2
S (ENIEN,SUIEN,APIEN,TKIEN,STOP)=0
F D Q:STOP
.S:TKIEN'="" TKIEN=$O(^PRST(455.5,TLIEN,"T","B",TKIEN))
.S:ENIEN'="" ENIEN=$O(^PRST(455.5,TLIEN,2,"B",ENIEN))
.I TKIEN="",ENIEN="" S STOP=1 Q
.W !
.I TKIEN'="" W $S($$SEP(TKIEN)="Y":"*",1:" "),$P($G(^VA(200,TKIEN,0)),U)
.I ENIEN'="" W ?40,$S($$SEP(ENIEN)="Y":"*",1:" "),$P($G(^VA(200,ENIEN,0)),U)
;
D HDR3
S (ENIEN,SUIEN,APIEN,TKIEN,STOP)=0
F D Q:STOP
.S:SUIEN'="" SUIEN=$O(^PRST(455.5,TLIEN,"S","B",SUIEN))
.S:APIEN'="" APIEN=$O(^PRST(455.5,TLIEN,3,"B",APIEN))
.I SUIEN="",APIEN="" S STOP=1 Q
.W !
.I SUIEN'="" W $S($$SEP(SUIEN)="Y":"*",1:" "),$P($G(^VA(200,SUIEN,0)),U)
.I APIEN'="" W ?40,$S($$SEP(APIEN)="Y":"*",1:" "),$P($G(^VA(200,APIEN,0)),U)
;
W !
;
N DIR,Y,DIRUT,CONT
S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to proceed"
S DIR("A",1)="Continuing with this process will DELETE ALL existing"
S DIR("A",2)="POC data entry and approval personnel. Then it will copy"
S DIR("A",3)="ETA timekeepers to POC data entry and ETA supervisors to"
S DIR("A",4)="POC approval personnel. Employees with an * in front of their"
S DIR("A",5)="name are separated and will NOT be copied."
D ^DIR
S CONT=$S(Y=1:1,1:0)
I 'CONT W !,"Aborted..." Q
;
;Kill off POC entry
;
K FDA
S IEN=0
F S IEN=$O(^PRST(455.5,TLIEN,2,IEN)) Q:IEN'>0 D
. S FDA(455.52,IEN_","_TLIEN_",",.01)="@"
I $D(FDA) D FILE^DIE("","FDA"),MSG^DIALOG()
;
;Kill off POC approvers
;
K FDA
S IEN=0
F S IEN=$O(^PRST(455.5,TLIEN,3,IEN)) Q:IEN'>0 D
. S FDA(455.531,IEN_","_TLIEN_",",.01)="@"
I $D(FDA) D FILE^DIE("","FDA"),MSG^DIALOG()
;
;Update POC Entry with timekeepers
S (TKIEN,J)=0
K FDA,IENS
F S TKIEN=$O(^PRST(455.5,TLIEN,"T","B",TKIEN)) Q:TKIEN'>0 D
. ;check for separation
. S SEPFLAG=$$SEP(TKIEN)
. Q:SEPFLAG="Y"
. S J=J+1
. S IENS(J)=J
. S FDA(455.52,"+"_J_","_TLIEN_",",.01)=TKIEN
I $D(FDA) D UPDATE^DIE("","FDA","IENS"),MSG^DIALOG()
;
;Update POC Approvers with supervisors
;
S (SUIEN,J)=0
K FDA,IENS
S SUIEN=0
F S SUIEN=$O(^PRST(455.5,TLIEN,"S","B",SUIEN)) Q:SUIEN'>0 D
. ;check for separation
. S SEPFLAG=$$SEP(SUIEN)
. Q:SEPFLAG="Y"
. S J=J+1
. S IENS(J)=J
. S FDA(455.531,"+"_J_","_TLIEN_",",.01)=SUIEN
I $D(FDA) D UPDATE^DIE("","FDA","IENS"),MSG^DIALOG()
W !,"Copied..."
Q
;
SEP(IEN200) ;
; missing paid ien treated same as separated employee for this process
N IEN450,SEPFLAG
S SEPFLAG=""
S IEN450=$G(^VA(200,IEN200,450))
I 'IEN450 S SEPFLAG="Y" Q SEPFLAG
S SEPFLAG=$P($G(^PRSPC(IEN450,1)),U,33)
Q SEPFLAG
;
HDR2 ; Header
W !,"ETA TIMEKEEPER",?40,"POC DATA ENTRY"
W !,"--------------------------------------------------------------------------------"
Q
;
HDR3 ;
W !!,"ETA SUPERVISOR",?40,"POC APPROVAL"
W !,"--------------------------------------------------------------------------------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSNCTL 4239 printed Apr 09, 2024@21:28:27 Page 2
PRSNCTL ;WOIFO/DWA - Edit T&L Unit POC Entry and Approval Personnel ;11/24/09
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
EDIT ; Enter/Edit POC Entry and Approval Personnel for a T&L Unit
+1 NEW TEMPLATE,STOP
SET STOP=0
+2 SET TEMPLATE="[PRSN EDIT TL POC]"
+3 FOR
Begin DoDot:1
+4 DO MAIN(.STOP,TEMPLATE)
End DoDot:1
if STOP>0
QUIT
+5 ;
+6 QUIT
+7 ;
DISP ; Display T&L Unit
+1 NEW TEMPLATE,STOP
SET STOP=0
+2 SET TEMPLATE="[PRSA TL DISP]"
+3 FOR
Begin DoDot:1
+4 DO MAIN(.STOP,TEMPLATE)
End DoDot:1
if STOP>0
QUIT
+5 ;
+6 QUIT
+7 ;
MAIN(STOP,T) ;
+1 NEW TLI,DA,DDSFILE,DR,DS
+2 SET STOP=0
+3 SET TLI=$$INIT()
+4 IF TLI'>0
SET STOP=1
QUIT
+5 SET DA=+TLI
SET DDSFILE=455.5
SET DR=T
+6 DO ^DDS
KILL DS
+7 QUIT
+8 ;
INIT() ;
+1 DO HDR
+2 NEW DIC,X,Y,DUOUT,DTOUT
+3 SET DIC="^PRST(455.5,"
SET DIC(0)="AEQLM"
SET DIC("A")="Select T&L Unit: "
DO ^DIC
KILL DIC
+4 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y'>0)
QUIT 0
+5 QUIT Y
+6 ;
HDR ; Header
+1 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 WRITE !,?26,"VA TIME & ATTENDANCE SYSTEM",!
+3 WRITE ?24,"EDIT POC ENTRY & APPROVAL PERSONNEL",!
+4 WRITE ?36,"T&L UNIT",!!!
+5 ;
+6 QUIT
+7 ;
TL2PEV ;OVERWRITE T&L TIMEKEEPERS AND SUPERVISORS TO PEV DATA ENTRY AND
+1 ;APPROVERS
+2 ;
+3 ;Prompt for T&L unit
+4 ;
+5 NEW DIC,X,Y,DUOUT,DTOUT
+6 SET DIC="^PRST(455.5,"
SET DIC(0)="AEQM"
SET DIC("A")="Select T&L Unit: "
+7 DO ^DIC
+8 if $DATA(DUOUT)!$DATA(DTOUT)!Y'>0
QUIT
+9 NEW TLIEN,ENIEN,SUIEN,APIEN,TKIEN,IENS,IEN,FDA,J,STOP,IEN450
+10 SET TLIEN=+Y
+11 ;
+12 DO HDR2
+13 SET (ENIEN,SUIEN,APIEN,TKIEN,STOP)=0
+14 FOR
Begin DoDot:1
+15 if TKIEN'=""
SET TKIEN=$ORDER(^PRST(455.5,TLIEN,"T","B",TKIEN))
+16 if ENIEN'=""
SET ENIEN=$ORDER(^PRST(455.5,TLIEN,2,"B",ENIEN))
+17 IF TKIEN=""
IF ENIEN=""
SET STOP=1
QUIT
+18 WRITE !
+19 IF TKIEN'=""
WRITE $SELECT($$SEP(TKIEN)="Y":"*",1:" "),$PIECE($GET(^VA(200,TKIEN,0)),U)
+20 IF ENIEN'=""
WRITE ?40,$SELECT($$SEP(ENIEN)="Y":"*",1:" "),$PIECE($GET(^VA(200,ENIEN,0)),U)
End DoDot:1
if STOP
QUIT
+21 ;
+22 DO HDR3
+23 SET (ENIEN,SUIEN,APIEN,TKIEN,STOP)=0
+24 FOR
Begin DoDot:1
+25 if SUIEN'=""
SET SUIEN=$ORDER(^PRST(455.5,TLIEN,"S","B",SUIEN))
+26 if APIEN'=""
SET APIEN=$ORDER(^PRST(455.5,TLIEN,3,"B",APIEN))
+27 IF SUIEN=""
IF APIEN=""
SET STOP=1
QUIT
+28 WRITE !
+29 IF SUIEN'=""
WRITE $SELECT($$SEP(SUIEN)="Y":"*",1:" "),$PIECE($GET(^VA(200,SUIEN,0)),U)
+30 IF APIEN'=""
WRITE ?40,$SELECT($$SEP(APIEN)="Y":"*",1:" "),$PIECE($GET(^VA(200,APIEN,0)),U)
End DoDot:1
if STOP
QUIT
+31 ;
+32 WRITE !
+33 ;
+34 NEW DIR,Y,DIRUT,CONT
+35 SET DIR(0)="Y"
SET DIR("B")="No"
SET DIR("A")="Do you want to proceed"
+36 SET DIR("A",1)="Continuing with this process will DELETE ALL existing"
+37 SET DIR("A",2)="POC data entry and approval personnel. Then it will copy"
+38 SET DIR("A",3)="ETA timekeepers to POC data entry and ETA supervisors to"
+39 SET DIR("A",4)="POC approval personnel. Employees with an * in front of their"
+40 SET DIR("A",5)="name are separated and will NOT be copied."
+41 DO ^DIR
+42 SET CONT=$SELECT(Y=1:1,1:0)
+43 IF 'CONT
WRITE !,"Aborted..."
QUIT
+44 ;
+45 ;Kill off POC entry
+46 ;
+47 KILL FDA
+48 SET IEN=0
+49 FOR
SET IEN=$ORDER(^PRST(455.5,TLIEN,2,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+50 SET FDA(455.52,IEN_","_TLIEN_",",.01)="@"
End DoDot:1
+51 IF $DATA(FDA)
DO FILE^DIE("","FDA")
DO MSG^DIALOG()
+52 ;
+53 ;Kill off POC approvers
+54 ;
+55 KILL FDA
+56 SET IEN=0
+57 FOR
SET IEN=$ORDER(^PRST(455.5,TLIEN,3,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+58 SET FDA(455.531,IEN_","_TLIEN_",",.01)="@"
End DoDot:1
+59 IF $DATA(FDA)
DO FILE^DIE("","FDA")
DO MSG^DIALOG()
+60 ;
+61 ;Update POC Entry with timekeepers
+62 SET (TKIEN,J)=0
+63 KILL FDA,IENS
+64 FOR
SET TKIEN=$ORDER(^PRST(455.5,TLIEN,"T","B",TKIEN))
if TKIEN'>0
QUIT
Begin DoDot:1
+65 ;check for separation
+66 SET SEPFLAG=$$SEP(TKIEN)
+67 if SEPFLAG="Y"
QUIT
+68 SET J=J+1
+69 SET IENS(J)=J
+70 SET FDA(455.52,"+"_J_","_TLIEN_",",.01)=TKIEN
End DoDot:1
+71 IF $DATA(FDA)
DO UPDATE^DIE("","FDA","IENS")
DO MSG^DIALOG()
+72 ;
+73 ;Update POC Approvers with supervisors
+74 ;
+75 SET (SUIEN,J)=0
+76 KILL FDA,IENS
+77 SET SUIEN=0
+78 FOR
SET SUIEN=$ORDER(^PRST(455.5,TLIEN,"S","B",SUIEN))
if SUIEN'>0
QUIT
Begin DoDot:1
+79 ;check for separation
+80 SET SEPFLAG=$$SEP(SUIEN)
+81 if SEPFLAG="Y"
QUIT
+82 SET J=J+1
+83 SET IENS(J)=J
+84 SET FDA(455.531,"+"_J_","_TLIEN_",",.01)=SUIEN
End DoDot:1
+85 IF $DATA(FDA)
DO UPDATE^DIE("","FDA","IENS")
DO MSG^DIALOG()
+86 WRITE !,"Copied..."
+87 QUIT
+88 ;
SEP(IEN200) ;
+1 ; missing paid ien treated same as separated employee for this process
+2 NEW IEN450,SEPFLAG
+3 SET SEPFLAG=""
+4 SET IEN450=$GET(^VA(200,IEN200,450))
+5 IF 'IEN450
SET SEPFLAG="Y"
QUIT SEPFLAG
+6 SET SEPFLAG=$PIECE($GET(^PRSPC(IEN450,1)),U,33)
+7 QUIT SEPFLAG
+8 ;
HDR2 ; Header
+1 WRITE !,"ETA TIMEKEEPER",?40,"POC DATA ENTRY"
+2 WRITE !,"--------------------------------------------------------------------------------"
+3 QUIT
+4 ;
HDR3 ;
+1 WRITE !!,"ETA SUPERVISOR",?40,"POC APPROVAL"
+2 WRITE !,"--------------------------------------------------------------------------------"
+3 QUIT
