149 lines
4.9 KiB
Mathematica
149 lines
4.9 KiB
Mathematica
PRSPDESR ; HISC/MGD - Display PT Phy ESR ;05/01/05
|
|
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
PAY ; Payroll Entry
|
|
S PRSTLV=7
|
|
D TOP ; print header
|
|
P1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
|
|
W ! D ^DIC S PRSIEN=+Y K DIC G:PRSIEN<1 EX
|
|
S TLE=$P($G(^PRSPC(PRSIEN,0)),"^",8)
|
|
S DIC="^PRST(458,",DIC(0)="AEQM",DIC("A")="Select PAY PERIOD: "
|
|
W ! D ^DIC K DIC G:Y<1 EX
|
|
S PPI=+Y
|
|
S PPE=$P(Y,U,2)
|
|
D L1 ;ask device
|
|
G P1 ;ask for employee again
|
|
;
|
|
TK ; TimeKeeper Entry
|
|
S PRSTLV=2 G T0
|
|
;
|
|
SUP ; Supervisor Entry
|
|
S PRSTLV=3
|
|
T0 D TOP ; print header
|
|
D ^PRSAUTL G:TLI<1 EX
|
|
T1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
|
|
S DIC("S")="I $P(^(0),""^"",8)=TLE" S D="ATL"_TLE W ! D IX^DIC
|
|
S PRSIEN=+Y K DIC G:PRSIEN<1 EX
|
|
S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=3041001 W ! D ^%DT
|
|
G:Y<1 EX
|
|
S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
|
|
G EX:PPI<1
|
|
S PPE=$P($G(^PRST(458,PPI,0)),U,1)
|
|
D L1 ;ask device
|
|
G T1 ;ask for employee again
|
|
;
|
|
EMP ; Employee Entry
|
|
S PRSTLV=1 D TOP S PRSIEN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
|
|
I SSN'="" S PRSIEN=$O(^PRSPC("SSN",SSN,0))
|
|
I 'PRSIEN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
|
|
S PRSIEN=PRSIEN
|
|
S TLE=$P($G(^PRSPC(PRSIEN,0)),"^",8)
|
|
S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=3040101 W ! D ^%DT
|
|
G:Y<1 EX
|
|
S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
|
|
S MIEN=+$$MIEN^PRSPUT1(PRSIEN,D1)
|
|
G EX:PPI<1
|
|
S PPE=$P($G(^PRST(458,PPI,0)),U,1)
|
|
D L1 G EX
|
|
;
|
|
TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
|
|
W !?27,"DISPLAY PT PHYSICIAN ESR" Q
|
|
L1 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ"
|
|
D ^%ZIS K %ZIS,IOP
|
|
Q:POP
|
|
I $D(IO("Q")) D Q
|
|
. S PRSAPGM="DIS^PRSPDESR",PRSALST="PRSIEN^TLE^PPI^PPE^DATA7"
|
|
. D QUE^PRSAUTL
|
|
U IO D DIS
|
|
I $E(IOST,1,2)="C-",'QT D H1
|
|
D ^%ZISC K %ZIS,IOP Q
|
|
;
|
|
DIS ; Display 14 days
|
|
;
|
|
S PDT=$G(^PRST(458,PPI,2)),STAT=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),"^",2)
|
|
S QT=0,DASH="",$P(DASH,"_",80)="_"
|
|
S IDAYS=0
|
|
F DAY=1:1:14 D Q:QT
|
|
. S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
|
|
. S STAT=$P(DATA7,U,1) ; ESR Daily Status
|
|
. I STAT<4 S IDAYS=IDAYS+1
|
|
D HDR1
|
|
; Check to see if the PTP had a memorandum during this PP.
|
|
S DAY1=$P($G(^PRST(458,PPI,1)),U,1)
|
|
I +$$MIEN^PRSPUT1(PRSIEN,DAY1)=0 D Q:QT
|
|
. W !!,"This employee did not have an active Memorandum during this Pay Period."
|
|
. S QT=1
|
|
F DAY=1:1:14 D Q:QT
|
|
. S DATA0=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,0))
|
|
. S DATA5=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
|
|
. S DATA6=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,6))
|
|
. S DATA7=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7))
|
|
. S T1=$P(DATA0,U,2) ; Tour #1
|
|
. S T1EX=$S(T1:$P($G(^PRST(457.1,T1,0)),U,1),1:"") ; Tour #1 External
|
|
. S STAT=$P(DATA7,U,1) ; ESR Daily Status
|
|
. S STATEX=$$EXTERNAL^DILFD(458.02,146,"",STAT)
|
|
. W !,$P(PDT,U,DAY),?14,$J(T1,4)," ",T1EX,?68," ",STATEX
|
|
. S T2=$P(DATA0,U,13) ; Tour #2
|
|
. I T2 D
|
|
. . S T2EX=$S(T2:$P($G(^PRST(457.1,T2,0)),U,1),1:"") ; Tour #2 External
|
|
. . W !?14,$J(T2,4)," ",T2EX
|
|
. S EDLSM=$P(DATA7,U,3) ; ESR DAY LAST SIGN METHOD
|
|
. I EDLSM=2 S STATEX=STATEX_" - EA" ; Posted by Extended Absence
|
|
. S QUIT=0
|
|
. F SEG=1:5:31 D:$Y>(IOSL-3) HDR Q:QT!(QUIT) D Q:QT!(QUIT)
|
|
. . S START=$P(DATA5,U,SEG)
|
|
. . I START="",SEG>1 S QUIT=1
|
|
. . Q:START=""
|
|
. . S STOP=$P(DATA5,U,SEG+1),TOT=$P(DATA5,U,SEG+2)
|
|
. . S TOTEX=""
|
|
. . I TOT'="" D
|
|
. . . S TOTEX=$O(^PRST(457.3,"B",TOT,0))
|
|
. . . S TOTEX=$E($P($G(^PRST(457.3,TOTEX,0)),U,2),1,14)
|
|
. . . S TOTEX=TOT_" "_TOTEX
|
|
. . S RC=$P(DATA5,U,SEG+3),MT=$P(DATA5,U,SEG+4)
|
|
. . S HRS=$$ELAPSE^PRSPESR2(MT,START,STOP)
|
|
. . W !?21,START,"-",STOP,?36,TOTEX,?56,$J(MT,2)," ",$J(HRS,5)
|
|
. . D:$Y>(IOSL-3) HDR
|
|
. . Q:QT!(QUIT)
|
|
. . I RC'="" D Q:QT!(QUIT)
|
|
. . . S RCEX=$P($G(^PRST(457.4,RC,0)),U,4)
|
|
. . . W !?38,RCEX
|
|
. . . D:$Y>(IOSL-3) HDR
|
|
. . Q:QT!(QUIT)
|
|
. Q:QT
|
|
. ;
|
|
. ; Display any PTP or Supervisor Remarks
|
|
. S PTPRMKS=$P(DATA6,U,1) ; PTP Remarks
|
|
. I PTPRMKS'="" D Q:QT!(QUIT)
|
|
. . W !," PTP Remarks: ",PTPRMKS
|
|
. . D:$Y>(IOSL-3) HDR
|
|
. S SUPRMKS=$P(DATA6,U,2) ; Supervisor Remarks
|
|
. I SUPRMKS'="" D Q:QT!(QUIT)
|
|
. . W !," Sup Remarks: ",SUPRMKS
|
|
. . D:$Y>(IOSL-3) HDR
|
|
Q
|
|
;====================================================================
|
|
HDR ; Display Header
|
|
D H1 Q:QT W @IOF
|
|
HDR1 S SCRTTL="PT PHYSICIAN ESR FOR PP "_PPE
|
|
D HDR^PRSPUT1(PRSIEN,SCRTTL,,,PPI)
|
|
W !?30,"Incomplete Days: "_$J(IDAYS,2)
|
|
W !,"Day",?14,"Tour Description",?69,"Status"
|
|
W !?21,"Postings",?36,"Time Code",?55,"Meal Hours"
|
|
W !?38,"Remarks Code"
|
|
W !,DASH
|
|
Q
|
|
;
|
|
H1 I $E(IOST,1,2)="C-" D
|
|
. W !
|
|
. S DIR(0)="E",DIR("A")="Press RETURN to continue"
|
|
. D ^DIR K DIR
|
|
. I $D(DIRUT) S QT=1
|
|
Q
|
|
EX ; Clean up variables
|
|
K D,D1,DASH,DATA0,DATA5,DATA6,DATA7,DAY,DAY1,DIRUT,EDLSM,HRS,IDAYS
|
|
K MIEN,MT,PDT,POP,PPE,PPI,PRSALST,PRSAPGM,PRSIEN,PRSTLV,PTPRMKS,QUIT
|
|
K QT,RC,RCEX,SCRTTL,SEG,SSN,START,STAT,STATEX,SUPRMKS,STOP,T1,T1EX
|
|
K T2,T2EX,TLE,TLI,TLSCREEN,TOT,TOTEX,X,Y,%DT,%ZIS
|
|
Q
|