source: WorldVistAEHR/trunk/r/PAID-PRS/PRSPUT2.m@ 1610

Last change on this file since 1610 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1PRSPUT2 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #2 ;07/08/2005
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;The following routine contains various utilities for the Part Time
6 ;Physician functionality that was added as part of patch PRS*4.0*93.
7 ;
8 ;-----------------------------------------------------------------------
9 ; Display information on the hours worked by the PT Physician per PP
10 ; Input: PRSIEN - IEN of the PT Physician
11 ; MIEN - IEN of the PT Phy's memorandum in #458.7
12 ; ARRAY - The array where the message to be printed will be
13 ; stored. (Optional) If not specified, no array will
14 ; be created.
15 ; INDEX - The index where the array will start. (optional) This
16 ; will be set to 1 if no index is passed.
17 ;
18 ; Output: 6 line summary of the Pay Periods covered by the PT Phy's
19 ; memorandum and the hours worked during each of them.
20 ; Array with the same data if the ARRAY parameter is passed.
21 ;-----------------------------------------------------------------------
22PPSUM(PRSIEN,MIEN,ARRAY,INDEX) ;
23 ;
24 Q:'PRSIEN&('MIEN)
25 I $G(INDEX)="",($G(ARRAY)'="") D INDEX^PRSPUT1
26 N I,J,PPHRS,PPNUM,TEXT
27 S TEXT=""
28 D A1^PRSPUT1 ; Blank Line
29 F I=1:1:6 D
30 . S TEXT=" "
31 . F J=I:6:26 D
32 . . S PPNUM=$$GET1^DIQ(458.701,J_","_MIEN_",",.01)_": "
33 . . S TEXT=TEXT_PPNUM
34 . . S PPHRS=$$GET1^DIQ(458.701,J_","_MIEN_",",1)
35 . . S TEXT=TEXT_$S(PPHRS'="":$J(PPHRS,6,2),1:" ")
36 . . S TEXT=TEXT_$S(J'<25:"",1:" ")
37 . D A1^PRSPUT1
38 D A1^PRSPUT1,A1^PRSPUT1 ; 2 Blank lines
39 Q
40 ;
41 ;----------------------------------------------------------------------
42 ; Retrieve and display the current status of each daily ESR within
43 ; the specified PP
44 ; Input: PRSIEN - IEN of the PT Physician
45 ; PPI - IEN of the Pay Period
46 ;
47 ; Output: 8 lines with the summary of the daily ESRs within the PP
48 ;-----------------------------------------------------------------------
49ESRSTAT(PRSIEN,PPI) ;
50 Q:'PRSIEN&('PPI)
51 N ATOT,DATA,DAY,DAY2CHK,DAYE,DTEXT,ESRHRS,HRS,I,INDX,J,MEAL,SEG,START
52 N STATEX,STATUS,STOP,TEXT,TOT
53 S DAYE=$G(^PRST(458,PPI,2)),(ESRHRS(1),ESRHRS(2))=0
54 F DAY=1:1:14 D
55 . S INDX=$S(DAY<8:1,1:2)
56 . S DATA=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
57 . F SEG=1:5:31 D
58 . . S START=$P(DATA,U,SEG),STOP=$P(DATA,U,SEG+1),TOT=$P(DATA,U,SEG+2)
59 . . Q:START=""
60 . . Q:TOT="WP" ; Don't count Without Pay
61 . . S MEAL=$P(DATA,U,SEG+4)
62 . . S HRS=$$AMT^PRSPSAPU(START,STOP,MEAL)
63 . . S ESRHRS(INDX)=ESRHRS(INDX)+HRS
64 S TEXT=" ESR Hours Week 1: "_$J(ESRHRS(1),6,2)
65 S TEXT=TEXT_" Week 2: "_$J(ESRHRS(2),6,2)
66 S TEXT=TEXT_" Total: "_$J(ESRHRS(1)+ESRHRS(2),6,2)
67 W !,TEXT
68 W !,"Day Week 1 - ",$P(DAYE,U,1),?41,"Day Week 2 - ",$P(DAYE,U,8)
69 ; Loop through each daily ESR record
70 F DAY=1:1:7 D
71 . S DAY2CHK=DAY D ATOT
72 . S $E(DTEXT,42)=""
73 . S TEXT=DTEXT
74 . S DAY2CHK=DAY2CHK+7 D ATOT
75 . S TEXT=TEXT_DTEXT
76 . W !,TEXT
77 Q
78 ;
79ATOT ; Convert STATUS to external and determine Types of Time posted
80 S ATOT="" ; All Types Of Time posted on the day
81 S STATUS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,7)),U,1)
82 S STATEX=$$EXTERNAL^DILFD(458.02,146,"",STATUS)
83 S DATA=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,5))
84 S DTEXT=$S(DAY2CHK<10:" "_DAY2CHK,1:DAY2CHK)
85 S DTEXT=DTEXT_" "_$E($P(DAYE,U,DAY),1,3)_" "_STATEX
86 I DATA'="" D
87 . F SEG=0:1:6 Q:$P(DATA,U,5*SEG+1)="" D
88 . . S TOT=$P(DATA,U,5*SEG+3)
89 . . I TOT'=""&(ATOT'[TOT) S ATOT=$S(ATOT="":TOT,1:ATOT_", "_TOT)
90 ; If status is RESUBMIT check for Supervisor text
91 N SUPCOM
92 S SUPCOM=""
93 I STATUS=3 D
94 . S SUPCOM=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,6)),U,2)
95 . I SUPCOM'="" S ATOT=" "_SUPCOM
96 I "^2^4^5^"[("^"_STATUS_"^") S $E(DTEXT,19,20)="- "
97 I STATUS=3,SUPCOM="" S $E(DTEXT,19,20)="- "
98 S DTEXT=DTEXT_ATOT
99 Q
100 ;
101PRSIEN(MSGF) ; Employee IEN Extrinsic Function
102 ; input
103 ; MSGF - (optional) message flag, true (=1) to write error message
104 ; DUZ - must be defined in symbol table
105 ; returns IEN in file 450 or null
106 N PRSIEN,SSN
107 S PRSIEN=""
108 S SSN=$P($G(^VA(200,DUZ,1)),"^",9)
109 S:SSN'="" PRSIEN=$O(^PRSPC("SSN",SSN,0))
110 I 'PRSIEN,$G(MSGF) W $C(7),!!,"Your SSN was not found in both the New Person & Employee File!"
111 Q PRSIEN
112 ;
113ESIGC(MSGF) ; Electronic Signature Code Extrinsic Function
114 ; input
115 ; MSGF - (optional) message flag, true (=1) to write error message
116 ; DUZ - must be defined in symbol table
117 ; returns true (=1) if the user has an electronic signature code
118 ; false (=0) if the user does not
119 N PRSRET
120 S PRSRET=($$GET1^DIQ(200,DUZ_",",20.4)'="")
121 I 'PRSRET,$G(MSGF) W $C(7),!!,"You must establish an electronic signature code before using this option!",!,"This can be done with the 'Electronic Signature code Edit' option."
122 Q PRSRET
Note: See TracBrowser for help on using the repository browser.