Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSALD

PRSALD.m

Go to the documentation of this file.
  1. PRSALD ;HISC/MGD-Labor Distribution Codes Edit ;06/28/2003
  1. ;;4.0;PAID;**82,114,115**;Sep 21, 1995;Build 2
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;Patch *115 modifies tag POST to display via roll & scroll in place of Screenman view
  1. Q
  1. PAY ; Payroll Entry
  1. N PPERIOD,PRSCNT,PRSDSH,PRSLIN,PRSREC,PRSQUIT
  1. S PRSTLV=7
  1. P1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
  1. W ! D ^DIC S DFN=+Y K DIC G:DFN<1 EX
  1. S TLE=$P($G(^PRSPC(DFN,0)),"^",8)
  1. D POST
  1. G P1
  1. Q
  1. TL ; Timekeeper Entry. Select T & L Unit
  1. N PP,PPE,PPI,PRSTLV,TLI
  1. S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
  1. ;
  1. LASTPP ; Get Last PP received in 459
  1. S PP="A"
  1. S PP=$O(^PRST(459,PP),-1)
  1. S PPE=$P($G(^PRST(459,PP,0)),"^",1)
  1. S PPI=""
  1. S PPI=$O(^PRST(458,"B",PPE,PPI))
  1. S PPE=PPE_" "_$P($G(^PRST(458,PPI,2)),"^",1)_" -> "_$P($G(^PRST(458,PPI,2)),"^",14)
  1. ;
  1. NME ; Select individual employee
  1. K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
  1. G:DFN<1 EX S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB) G NME
  1. ;
  1. EX ; Clean up variables and Exit
  1. K D,DA,DDSFILE,DFN,DR,GLOB,LP,NN,TLE,Y,ZS,%
  1. G KILL^XUSCLEAN
  1. ;
  1. POST ; Edit & Post Labor Distribution Codes
  1. Q:'DFN
  1. S DA=DFN,PRSDSH="",PRSLIN="",$P(PRSDSH,"-",81)="",$P(PRSLIN,"_",81)=""
  1. ;S DDSFILE=450,DR="[PRSA LD POST]"
  1. ;D ^DDS K DS Q:'$D(ZS)
  1. ;new roll & scroll display for labor dist
  1. S PRSREC=$G(^PRSPC(DFN,0))
  1. W @IOF,$P(PRSREC,U),?26,"VA TIME & ATTENDANCE SYSTEM" S Y=$P(PRSREC,U,9) W ?68,$S(PRSTLV=2&Y:$E(Y)_"XX-XX-"_$E(Y,6,9),PRSTLV=7&Y:$E(Y,1,3)_"-"_$E(Y,4,5)_"-"_$E(Y,6,9),1:"XXX-XX-XXXX")
  1. W !,"Station: ",$P(PRSREC,U,8),?28,"Labor Distribution Codes",?71,"T&L: ",$P(PRSREC,U,8)
  1. W !,?21,$G(PPE)
  1. W !!,?12,"CODE",?24,"PERCENT",?40,"COST CENTER",?59,"FUND CTRL PT",!,PRSDSH
  1. F PRSCNT=1:1:4 S PRSREC=$G(^PRSPC(DA,"LD",PRSCNT,0)) W !,"LD CODE" I PRSREC'="" W ?8,PRSCNT,?12,$P(PRSREC,U,2),?25,$P(PRSREC,U,3),?43,$P(PRSREC,U,4),?64,$P(PRSREC,U,5)
  1. W !!!
  1. F PRSCNT=1:1:4 S PRSREC=$G(^PRSPC(DA,"LD",PRSCNT,0)) W !,"COST CENTER" I PRSREC'="" W ?12,PRSCNT,?14,$P(PRSREC,U,4),?21 D
  1. . S Y=$P(PRSREC,U,4),SUB454="CC" D OT^PRSDUTIL
  1. . K SUB454 S PRSREC=Y
  1. . W PRSREC
  1. W !!,PRSLIN,!!!,"END OF DISPLAY, HIT RETURN TO QUIT" R PRSQUIT:120
  1. W @IOF
  1. Q
  1. ;
  1. ; The following code will be implemented in Phase 2 of the Labor Dist.
  1. ;
  1. D2 ; Select All or individual employee
  1. W !!,"Would you like to edit the Labor Codes in alphabetical order"
  1. S %=1 D YN^DICN I % S LP=% G EX:%=-1,LOOP:%=1,NME
  1. W !!,"Answer YES if you want all RECORDs brought up for which no data"
  1. W !,"has been entered." G D2
  1. Q
  1. ;
  1. LOOP ; Loop through all employees in selected T & L
  1. S LP=1,NN=""
  1. F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" D
  1. . F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 D
  1. . . S GLOB="" D POST D:GLOB]"" UNLOCK^PRSLIB00(GLOB) I 'LP G EX
  1. G EX
  1. Q
  1. ;
  1. PP ; Select Pay Period
  1. S DIC="^PRST(458,",DIC(0)="AEQZ",D="B"
  1. D IX^DIC
  1. Q:Y=-1
  1. S PPI=+Y,PPE="PP "_$P(Y,"^",2)_" "
  1. S PPE=PPE_$P($G(^PRST(458,PPI,2)),"^",1)_" -> "_$P($G(^PRST(458,PPI,2)),"^",14)
  1. ;
  1. LDOUT ; Convert LABOR DIST CODE EDITED BY field into its external format.
  1. ;
  1. I "IETP"'[Y&('+Y) D Q
  1. . S Y="Unknown"
  1. I Y="I" S Y="Initial Download"
  1. I Y="E" S Y="Edit & Update Download"
  1. I Y="T" S Y="Transfer Download"
  1. I Y="P" S Y="Payrun Download"
  1. I +Y D
  1. . S Y=$P($G(^VA(200,Y,0)),"^",1)
  1. . I Y="" S Y="Unknown"
  1. Q