| [613] | 1 | PRSPUT1 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #1 ;05/17/05
|
|---|
| 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 | ; Determine the IEN of the PT Physician's memorandum if any for the
|
|---|
| 10 | ; current date or the date specified in the MDAT parameter.
|
|---|
| 11 | ; Input: PTPIEN - IEN of the PT Physician
|
|---|
| 12 | ; MDAT - Optional - date within memorandum in FileMan format
|
|---|
| 13 | ;
|
|---|
| 14 | ; Output: IEN^STATUS
|
|---|
| 15 | ; IEN - of the PT Phy's memorandum in the #458.7 file or 0
|
|---|
| 16 | ; STATUS - of the memorandum
|
|---|
| 17 | ;-----------------------------------------------------------------------
|
|---|
| 18 | MIEN(PRSIEN,MDAT) ;
|
|---|
| 19 | Q:'PRSIEN 0_"^"
|
|---|
| 20 | N ENDAT,MDATA,QUIT,STATUS,STDAT,TDAT,MIEN
|
|---|
| 21 | S MDAT=$G(MDAT,DT)
|
|---|
| 22 | S (MIEN,QUIT)=0
|
|---|
| 23 | F S MIEN=$O(^PRST(458.7,"B",PRSIEN,MIEN)) Q:'MIEN D Q:QUIT
|
|---|
| 24 | . S MDATA=$G(^PRST(458.7,MIEN,0))
|
|---|
| 25 | . S STDAT=$P(MDATA,U,2) ; START DATE OF MEMORANDUM
|
|---|
| 26 | . S ENDAT=$P(MDATA,U,3) ; END DATE OF MEMORANDUM
|
|---|
| 27 | . S STATUS=$P(MDATA,U,6) ; STATUS OF MEMORANDUM
|
|---|
| 28 | . S TDAT=$P($G(^PRST(458.7,MIEN,4)),U,1) ; TERMINATION DATE
|
|---|
| 29 | . I TDAT D
|
|---|
| 30 | . . I TDAT<ENDAT S ENDAT=TDAT
|
|---|
| 31 | . I MDAT'<STDAT,MDAT'>ENDAT S QUIT=1
|
|---|
| 32 | I MIEN="" S MIEN=0,STATUS=0
|
|---|
| 33 | Q MIEN_"^"_STATUS
|
|---|
| 34 | ;
|
|---|
| 35 | ;-----------------------------------------------------------------------
|
|---|
| 36 | ;Display information on a PT Physician's memoranda
|
|---|
| 37 | ; Input: PRSIEN - IEN of the PT Physician.
|
|---|
| 38 | ; SCRTTL - Title for the screen.
|
|---|
| 39 | ; ARRAY - The array where the message to be printed will be
|
|---|
| 40 | ; stored. (optional) If not specified, no array will
|
|---|
| 41 | ; be created.
|
|---|
| 42 | ; INDEX - The index where the array will start. (optional) This
|
|---|
| 43 | ; will be set to 1 if no index is passed.
|
|---|
| 44 | ; PPI - Optional: IEN of the desired PP. If supplied, the
|
|---|
| 45 | ; external format will be displayed on line
|
|---|
| 46 | ;
|
|---|
| 47 | ; Output: VA header, screen title and 10 fields to identify the PT Phy
|
|---|
| 48 | ; Array with the same data if the ARRAY parameter is passed.
|
|---|
| 49 | ;-----------------------------------------------------------------------
|
|---|
| 50 | HDR(PRSIEN,SCRTTL,ARRAY,INDEX,PPI) ;
|
|---|
| 51 | Q:'PRSIEN
|
|---|
| 52 | S SCRTTL=$G(SCRTTL,"")
|
|---|
| 53 | S ARRAY=$G(ARRAY,"")
|
|---|
| 54 | I $G(INDEX)="",($G(ARRAY)'="") D INDEX
|
|---|
| 55 | N C0,DATE,PPE,SSN,TAB,TEXT,X,YR
|
|---|
| 56 | I $G(PPI)="" D ; If no PPI passed in get last PP in #459
|
|---|
| 57 | . S PPE="A",PPE=$O(^PRST(459,PPE),-1)
|
|---|
| 58 | . S PPE=$P($G(^PRST(459,PPE,0)),U,1)
|
|---|
| 59 | I $G(PPI)>0 S PPE=$P($G(^PRST(458,PPI,0)),U,1)
|
|---|
| 60 | S TEXT="PP:"_PPE,$E(TEXT,26)="",TEXT=TEXT_"VA TIME & ATTENDANCE SYSTEM"
|
|---|
| 61 | D NOW^%DTC
|
|---|
| 62 | S YR=%I(3)+1700,YR=$E(YR,3,4)
|
|---|
| 63 | S DATE=%I(1)_"/"_%I(2)_"/"_YR
|
|---|
| 64 | S $E(TEXT,73)="",TEXT=TEXT_DATE
|
|---|
| 65 | D A1 ; Line #1
|
|---|
| 66 | S TAB=39-($L(SCRTTL)\2)
|
|---|
| 67 | S $E(TEXT,TAB)="",TEXT=TEXT_SCRTTL
|
|---|
| 68 | D A1 ; Line #2
|
|---|
| 69 | S C0=^PRSPC(PRSIEN,0)
|
|---|
| 70 | S TEXT=$P(C0,U,1),$E(TEXT,70)=""
|
|---|
| 71 | S SSN=$P(C0,U,9)
|
|---|
| 72 | S SSN="XXX-XX-"_$E(SSN,6,9)
|
|---|
| 73 | S TEXT=TEXT_SSN
|
|---|
| 74 | D A1 ; Line #3
|
|---|
| 75 | S TEXT="Pay Plan: "_$P(C0,"^",21)_" Duty Basis: "_$P(C0,"^",10)
|
|---|
| 76 | S TEXT=TEXT_" FLSA: "_$P(C0,"^",12)_" Normal Hours: "
|
|---|
| 77 | S TEXT=TEXT_$J($P(C0,"^",16),3)_" Comp/Flex: "
|
|---|
| 78 | S TEXT=TEXT_$P($G(^PRSPC(PRSIEN,1)),"^",7)
|
|---|
| 79 | D A1 ; Line #4
|
|---|
| 80 | S TEXT="T&L: "_$P(C0,"^",8),$E(TEXT,69)=""
|
|---|
| 81 | S TEXT=TEXT_"Station: "_$P(C0,"^",7)
|
|---|
| 82 | D A1 ; Line #5
|
|---|
| 83 | K INDEX,%I
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | ;-----------------------------------------------------------------------
|
|---|
| 87 | ; Display information on a PT Physician's memoranda
|
|---|
| 88 | ; Input: PRSIEN - IEN of the PT Physician
|
|---|
| 89 | ; MIEN - IEN of the PT Phy's memorandum in #458.7
|
|---|
| 90 | ; ARRAY - The array where the message to be printed will be
|
|---|
| 91 | ; stored. (Optional) If not specified, no array will
|
|---|
| 92 | ; be created.
|
|---|
| 93 | ; INDEX - The index where the array will start. (optional) This
|
|---|
| 94 | ; will be set to 1 if no index is passed.
|
|---|
| 95 | ; HRSCO - Carrryover Hours from a prior memorandum. (optional)
|
|---|
| 96 | ;
|
|---|
| 97 | ; Output: 4 line summary of the PT Phy's current memorandum
|
|---|
| 98 | ; Array with the same data if the ARRAY parameter is passed.
|
|---|
| 99 | ;-----------------------------------------------------------------------
|
|---|
| 100 | MEM(PRSIEN,MIEN,ARRAY,INDEX,HRSCO) ;
|
|---|
| 101 | Q:'PRSIEN&('MIEN)
|
|---|
| 102 | I $G(INDEX)="",($G(ARRAY)'="") D INDEX
|
|---|
| 103 | N AHRS,AHTCM,COHRS,DATA,EDAT,ENDDAT,HRSWK,HTSHBW,I,IEN458,LASTDAY,LASTPP
|
|---|
| 104 | N LASTPPE,LPPP,NPHRS,OTHRS,POHC,POMC,POT,PPP,QUIT,TAB,TDAT,TDATEX,TEXT
|
|---|
| 105 | N THRSWK,TTEXT,WPHRS
|
|---|
| 106 | ; Load 0 node from #458.7. Quit if it doesn't exist
|
|---|
| 107 | S DATA=$G(^PRST(458.7,MIEN,0))
|
|---|
| 108 | Q:DATA=""
|
|---|
| 109 | ; Determine last PP processed
|
|---|
| 110 | S LASTPP="A"
|
|---|
| 111 | S LASTPP=$O(^PRST(459,LASTPP),-1)
|
|---|
| 112 | Q:'LASTPP
|
|---|
| 113 | S LASTPPE=$P(^PRST(459,LASTPP,0),U,1)
|
|---|
| 114 | S IEN458="",IEN458=$O(^PRST(458,"B",LASTPPE,IEN458))
|
|---|
| 115 | Q:'IEN458
|
|---|
| 116 | S LASTDAY=$P($G(^PRST(458,IEN458,2)),U,14)
|
|---|
| 117 | S TTEXT="Memorandum & Leave Status thru PP "_LASTPPE_" Ending "_LASTDAY
|
|---|
| 118 | S TAB=40-($L(TTEXT)\2)
|
|---|
| 119 | S $E(TEXT,TAB)="",TEXT=TEXT_TTEXT
|
|---|
| 120 | D A1 ; Line #1
|
|---|
| 121 | S Y=$P(DATA,U,2) ; START DATE
|
|---|
| 122 | D DD^%DT
|
|---|
| 123 | S STDAT=Y
|
|---|
| 124 | S (EDAT,Y)=$P(DATA,U,3) ; END DATE
|
|---|
| 125 | D DD^%DT
|
|---|
| 126 | S ENDDAT=Y
|
|---|
| 127 | ; Check for Termination
|
|---|
| 128 | S (TDAT,Y)=+$G(^PRST(458.7,MIEN,4))
|
|---|
| 129 | D DD^%DT
|
|---|
| 130 | S TDATEX=Y ; Termination Date External
|
|---|
| 131 | S AHRS=$P(DATA,U,4) ; AGREED HOURS
|
|---|
| 132 | S COHRS=$P(DATA,U,9) ; CARRYOVER HOURS
|
|---|
| 133 | S HRSCO=$G(HRSCO,0) ; HRS CARRIED OVER FROM PRIOR MEMO
|
|---|
| 134 | S NPHRS=$P(DATA,U,12) ; NON-PAY HOURS
|
|---|
| 135 | S WPHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
|
|---|
| 136 | S THRSWK=0.00 ; TOTAL HOURS WORKED
|
|---|
| 137 | S POMC=0.00 ; PERCENTAGE OF MEMORANDA COMPLETED
|
|---|
| 138 | S POHC=0.00 ; PERCENTAGE OF HOURS COMPLETED
|
|---|
| 139 | S AHTCM=0.00 ; AVERAGE HOURS TO COMPLETE MEMORANDUM
|
|---|
| 140 | S POT=0.00 ; % OFF TARGET
|
|---|
| 141 | S OTHRS=0.00 ; OFF TARGET HOURS
|
|---|
| 142 | S HRSWK=0.00 ; HRS TOTAL FROM WORKED PAY PERIODS
|
|---|
| 143 | ;
|
|---|
| 144 | S $E(TEXT,2)="",TEXT=TEXT_"Start Date: "_STDAT
|
|---|
| 145 | S $E(TEXT,29,31)="| ",TEXT=TEXT_"Agreed Hours: "_$J(AHRS,7,2)
|
|---|
| 146 | S $E(TEXT,55,57)="| ",TEXT=TEXT_" LWOP Hrs: "_$J(WPHRS,7,2)
|
|---|
| 147 | D A1 ; Line #2
|
|---|
| 148 | ;
|
|---|
| 149 | S LPPP=$$MEMCPP^PRSPUT3(MIEN)
|
|---|
| 150 | S PPP=$P(LPPP,U,2),LPPP=$P(LPPP,U,1)
|
|---|
| 151 | ; Check to see if last PP certified in #458 is in #459
|
|---|
| 152 | I LPPP'="",'$D(^PRST(459,"B",LPPP)) S PPP=PPP-1
|
|---|
| 153 | ; Loop to determine the total hours worked from multiple
|
|---|
| 154 | F I=1:1:PPP D
|
|---|
| 155 | . S HRSWK=HRSWK+$$GET1^DIQ(458.701,I_","_MIEN_",",1)
|
|---|
| 156 | S THRSWK=HRSWK+COHRS+HRSCO ; Adjust for carryover hours
|
|---|
| 157 | ; Hrs That Should Have Been Worked - has any NP and WP included
|
|---|
| 158 | S HTSHBW=((AHRS/26)*PPP)-NPHRS-WPHRS
|
|---|
| 159 | S OTHRS=THRSWK-HTSHBW
|
|---|
| 160 | S POHC=THRSWK/(AHRS-NPHRS-WPHRS)*100 ; Adjust % or Hrs Completed
|
|---|
| 161 | ; Only calculate the following if memo has started and not ended
|
|---|
| 162 | I PPP,PPP<26 D
|
|---|
| 163 | . I HTSHBW'=THRSWK D ; PTP has worked more or less than Ave Hrs/PP
|
|---|
| 164 | . . I THRSWK'<(AHRS-NPHRS-WPHRS) S AHTCM=0
|
|---|
| 165 | . . I THRSWK<(AHRS-NPHRS-WPHRS) S AHTCM=AHRS-THRSWK-NPHRS-WPHRS/(26-PPP)
|
|---|
| 166 | . . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
|
|---|
| 167 | . . S POT=THRSWK-POT/POT,POT=POT*100
|
|---|
| 168 | . I HTSHBW=THRSWK D ; PTP has worked exactly Ave Hrs/PP
|
|---|
| 169 | . . S AHTCM=AHRS-THRSWK-WPHRS-NPHRS/(26-PPP)
|
|---|
| 170 | . . S POT=0
|
|---|
| 171 | I PPP=26 D ; Memo has ended
|
|---|
| 172 | . S AHTCM=0
|
|---|
| 173 | . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
|
|---|
| 174 | . S POT=THRSWK-POT/POT,POT=POT*100
|
|---|
| 175 | I PPP=0 D ; 1st PP hasn't been processed
|
|---|
| 176 | . S AHTCM=AHRS-COHRS/26
|
|---|
| 177 | . S POT=0
|
|---|
| 178 | I TDAT D
|
|---|
| 179 | . S $E(TEXT,2)="",TEXT=TEXT_"TERMINATED: "_TDATEX
|
|---|
| 180 | I TDAT=0 S $E(TEXT,4)="",TEXT=TEXT_"End Date: "_ENDDAT
|
|---|
| 181 | S $E(TEXT,29,31)="| ",TEXT=TEXT_"Hours Worked: "_$J(HRSWK,7,2)
|
|---|
| 182 | S $E(TEXT,55,57)="| ",TEXT=TEXT_" Non Pay Hrs: "_$J(NPHRS,7,2)
|
|---|
| 183 | D A1 ; Line #3
|
|---|
| 184 | ;
|
|---|
| 185 | S POMC=PPP_" of 26 PP = "_$J(100*(PPP/26),6,2)_"%"
|
|---|
| 186 | I PPP<10 S $E(TEXT,6)="",TEXT=TEXT_POMC
|
|---|
| 187 | I PPP>9 S $E(TEXT,5)="",TEXT=TEXT_POMC
|
|---|
| 188 | S $E(TEXT,29,30)="| "
|
|---|
| 189 | S TEXT=TEXT_"Carryover Hrs: "_$J($S(HRSCO:HRSCO,1:COHRS),7,2)
|
|---|
| 190 | S $E(TEXT,55,57)="| ",TEXT=TEXT_"Off Target Hrs: "_$J(OTHRS,7,2)
|
|---|
| 191 | D A1 ; Line #4
|
|---|
| 192 | ;
|
|---|
| 193 | S TEXT="% Hrs Completed = "_$J(POHC,6,2)_"%"
|
|---|
| 194 | S $E(TEXT,29,31)="| ",TEXT=TEXT_" Total Hrs: "
|
|---|
| 195 | S TEXT=TEXT_$J(THRSWK,7,2)
|
|---|
| 196 | S $E(TEXT,55,57)="| ",TEXT=TEXT_" Off Target %: "_$J(POT,7,2)
|
|---|
| 197 | D A1 ; Line #5
|
|---|
| 198 | ;
|
|---|
| 199 | I PPP<26 D
|
|---|
| 200 | . S TEXT=(AHRS-NPHRS-WPHRS)-THRSWK,TEXT=TEXT/(26-PPP)
|
|---|
| 201 | . S TEXT=$FN(TEXT,"",2)
|
|---|
| 202 | . S TEXT=" Agreement will be met by averaging "_TEXT
|
|---|
| 203 | . S TEXT=TEXT_" Hrs/PP during remainder of memo."
|
|---|
| 204 | ;
|
|---|
| 205 | I PPP=26 D
|
|---|
| 206 | . S $E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
|
|---|
| 207 | ;
|
|---|
| 208 | I TDAT D
|
|---|
| 209 | . I LPPP'="" D
|
|---|
| 210 | . . S LPPP=$O(^PRST(458,"B",LPPP,0))
|
|---|
| 211 | . . S LPPP=$P($G(^PRST(458,LPPP,1)),U,14)
|
|---|
| 212 | . . I TDAT'>LPPP D Q
|
|---|
| 213 | . . . S TEXT="",$E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
|
|---|
| 214 | ;
|
|---|
| 215 | D A1 ; Line #6
|
|---|
| 216 | K INDEX,Y
|
|---|
| 217 | Q
|
|---|
| 218 | ;
|
|---|
| 219 | A1 ; Set TEXT into the array
|
|---|
| 220 | ;
|
|---|
| 221 | N A1
|
|---|
| 222 | W !,TEXT
|
|---|
| 223 | I $G(ARRAY)'="" D
|
|---|
| 224 | . S A1="S "_ARRAY_INDEX_")="_""""_TEXT_""""
|
|---|
| 225 | . X A1
|
|---|
| 226 | . S INDEX=INDEX+1
|
|---|
| 227 | S TEXT=""
|
|---|
| 228 | Q
|
|---|
| 229 | ;
|
|---|
| 230 | INDEX ; Get last index in array if not passed in
|
|---|
| 231 | ;
|
|---|
| 232 | S INDEX="S INDEX=$O("_ARRAY_"""A""),-1)"
|
|---|
| 233 | X INDEX
|
|---|
| 234 | I 'INDEX S INDEX=1 Q
|
|---|
| 235 | I INDEX S INDEX=INDEX+1
|
|---|
| 236 | Q
|
|---|
