PRSNCTL.m

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 ---PRSNCTL   4239     printed  Apr 23, 2025@18:41:42                                                                                                                                                                                                     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