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

PRSPUT1.m

Go to the documentation of this file.
  1. PRSPUT1 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #1 ;05/17/05
  1. ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;The following routine contains various utilities for the Part Time
  1. ;Physician functionality that was added as part of patch PRS*4.0*93.
  1. ;
  1. ;----------------------------------------------------------------------
  1. ; Determine the IEN of the PT Physician's memorandum if any for the
  1. ; current date or the date specified in the MDAT parameter.
  1. ; Input: PTPIEN - IEN of the PT Physician
  1. ; MDAT - Optional - date within memorandum in FileMan format
  1. ;
  1. ; Output: IEN^STATUS
  1. ; IEN - of the PT Phy's memorandum in the #458.7 file or 0
  1. ; STATUS - of the memorandum
  1. ;-----------------------------------------------------------------------
  1. MIEN(PRSIEN,MDAT) ;
  1. Q:'PRSIEN 0_"^"
  1. N ENDAT,MDATA,QUIT,STATUS,STDAT,TDAT,MIEN
  1. S MDAT=$G(MDAT,DT)
  1. S (MIEN,QUIT)=0
  1. F S MIEN=$O(^PRST(458.7,"B",PRSIEN,MIEN)) Q:'MIEN D Q:QUIT
  1. . S MDATA=$G(^PRST(458.7,MIEN,0))
  1. . S STDAT=$P(MDATA,U,2) ; START DATE OF MEMORANDUM
  1. . S ENDAT=$P(MDATA,U,3) ; END DATE OF MEMORANDUM
  1. . S STATUS=$P(MDATA,U,6) ; STATUS OF MEMORANDUM
  1. . S TDAT=$P($G(^PRST(458.7,MIEN,4)),U,1) ; TERMINATION DATE
  1. . I TDAT D
  1. . . I TDAT<ENDAT S ENDAT=TDAT
  1. . I MDAT'<STDAT,MDAT'>ENDAT S QUIT=1
  1. I MIEN="" S MIEN=0,STATUS=0
  1. Q MIEN_"^"_STATUS
  1. ;
  1. ;-----------------------------------------------------------------------
  1. ;Display information on a PT Physician's memoranda
  1. ; Input: PRSIEN - IEN of the PT Physician.
  1. ; SCRTTL - Title for the screen.
  1. ; ARRAY - The array where the message to be printed will be
  1. ; stored. (optional) If not specified, no array will
  1. ; be created.
  1. ; INDEX - The index where the array will start. (optional) This
  1. ; will be set to 1 if no index is passed.
  1. ; PPI - Optional: IEN of the desired PP. If supplied, the
  1. ; external format will be displayed on line
  1. ;
  1. ; Output: VA header, screen title and 10 fields to identify the PT Phy
  1. ; Array with the same data if the ARRAY parameter is passed.
  1. ;-----------------------------------------------------------------------
  1. HDR(PRSIEN,SCRTTL,ARRAY,INDEX,PPI) ;
  1. Q:'PRSIEN
  1. S SCRTTL=$G(SCRTTL,"")
  1. S ARRAY=$G(ARRAY,"")
  1. I $G(INDEX)="",($G(ARRAY)'="") D INDEX
  1. N C0,DATE,PPE,SSN,TAB,TEXT,X,YR
  1. I $G(PPI)="" D ; If no PPI passed in get last PP in #459
  1. . S PPE="A",PPE=$O(^PRST(459,PPE),-1)
  1. . S PPE=$P($G(^PRST(459,PPE,0)),U,1)
  1. I $G(PPI)>0 S PPE=$P($G(^PRST(458,PPI,0)),U,1)
  1. S TEXT="PP:"_PPE,$E(TEXT,26)="",TEXT=TEXT_"VA TIME & ATTENDANCE SYSTEM"
  1. D NOW^%DTC
  1. S YR=%I(3)+1700,YR=$E(YR,3,4)
  1. S DATE=%I(1)_"/"_%I(2)_"/"_YR
  1. S $E(TEXT,73)="",TEXT=TEXT_DATE
  1. D A1 ; Line #1
  1. S TAB=39-($L(SCRTTL)\2)
  1. S $E(TEXT,TAB)="",TEXT=TEXT_SCRTTL
  1. D A1 ; Line #2
  1. S C0=^PRSPC(PRSIEN,0)
  1. S TEXT=$P(C0,U,1),$E(TEXT,70)=""
  1. S SSN=$P(C0,U,9)
  1. S SSN="XXX-XX-"_$E(SSN,6,9)
  1. S TEXT=TEXT_SSN
  1. D A1 ; Line #3
  1. S TEXT="Pay Plan: "_$P(C0,"^",21)_" Duty Basis: "_$P(C0,"^",10)
  1. S TEXT=TEXT_" FLSA: "_$P(C0,"^",12)_" Normal Hours: "
  1. S TEXT=TEXT_$J($P(C0,"^",16),3)_" Comp/Flex: "
  1. S TEXT=TEXT_$P($G(^PRSPC(PRSIEN,1)),"^",7)
  1. D A1 ; Line #4
  1. S TEXT="T&L: "_$P(C0,"^",8),$E(TEXT,69)=""
  1. S TEXT=TEXT_"Station: "_$P(C0,"^",7)
  1. D A1 ; Line #5
  1. K INDEX,%I
  1. Q
  1. ;
  1. ;-----------------------------------------------------------------------
  1. ; Display information on a PT Physician's memoranda
  1. ; Input: PRSIEN - IEN of the PT Physician
  1. ; MIEN - IEN of the PT Phy's memorandum in #458.7
  1. ; ARRAY - The array where the message to be printed will be
  1. ; stored. (Optional) If not specified, no array will
  1. ; be created.
  1. ; INDEX - The index where the array will start. (optional) This
  1. ; will be set to 1 if no index is passed.
  1. ; HRSCO - Carrryover Hours from a prior memorandum. (optional)
  1. ;
  1. ; Output: 4 line summary of the PT Phy's current memorandum
  1. ; Array with the same data if the ARRAY parameter is passed.
  1. ;-----------------------------------------------------------------------
  1. MEM(PRSIEN,MIEN,ARRAY,INDEX,HRSCO) ;
  1. Q:'PRSIEN&('MIEN)
  1. I $G(INDEX)="",($G(ARRAY)'="") D INDEX
  1. N AHRS,AHTCM,COHRS,DATA,EDAT,ENDDAT,HRSWK,HTSHBW,I,IEN458,LASTDAY,LASTPP
  1. N LASTPPE,LPPP,NPHRS,OTHRS,POHC,POMC,POT,PPP,QUIT,TAB,TDAT,TDATEX,TEXT
  1. N THRSWK,TTEXT,WPHRS
  1. ; Load 0 node from #458.7. Quit if it doesn't exist
  1. S DATA=$G(^PRST(458.7,MIEN,0))
  1. Q:DATA=""
  1. ; Determine last PP processed
  1. S LASTPP="A"
  1. S LASTPP=$O(^PRST(459,LASTPP),-1)
  1. Q:'LASTPP
  1. S LASTPPE=$P(^PRST(459,LASTPP,0),U,1)
  1. S IEN458="",IEN458=$O(^PRST(458,"B",LASTPPE,IEN458))
  1. Q:'IEN458
  1. S LASTDAY=$P($G(^PRST(458,IEN458,2)),U,14)
  1. S TTEXT="Memorandum & Leave Status thru PP "_LASTPPE_" Ending "_LASTDAY
  1. S TAB=40-($L(TTEXT)\2)
  1. S $E(TEXT,TAB)="",TEXT=TEXT_TTEXT
  1. D A1 ; Line #1
  1. S Y=$P(DATA,U,2) ; START DATE
  1. D DD^%DT
  1. S STDAT=Y
  1. S (EDAT,Y)=$P(DATA,U,3) ; END DATE
  1. D DD^%DT
  1. S ENDDAT=Y
  1. ; Check for Termination
  1. S (TDAT,Y)=+$G(^PRST(458.7,MIEN,4))
  1. D DD^%DT
  1. S TDATEX=Y ; Termination Date External
  1. S AHRS=$P(DATA,U,4) ; AGREED HOURS
  1. S COHRS=$P(DATA,U,9) ; CARRYOVER HOURS
  1. S HRSCO=$G(HRSCO,0) ; HRS CARRIED OVER FROM PRIOR MEMO
  1. S NPHRS=$P(DATA,U,12) ; NON-PAY HOURS
  1. S WPHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
  1. S THRSWK=0.00 ; TOTAL HOURS WORKED
  1. S POMC=0.00 ; PERCENTAGE OF MEMORANDA COMPLETED
  1. S POHC=0.00 ; PERCENTAGE OF HOURS COMPLETED
  1. S AHTCM=0.00 ; AVERAGE HOURS TO COMPLETE MEMORANDUM
  1. S POT=0.00 ; % OFF TARGET
  1. S OTHRS=0.00 ; OFF TARGET HOURS
  1. S HRSWK=0.00 ; HRS TOTAL FROM WORKED PAY PERIODS
  1. ;
  1. S $E(TEXT,2)="",TEXT=TEXT_"Start Date: "_STDAT
  1. S $E(TEXT,29,31)="| ",TEXT=TEXT_"Agreed Hours: "_$J(AHRS,7,2)
  1. S $E(TEXT,55,57)="| ",TEXT=TEXT_" LWOP Hrs: "_$J(WPHRS,7,2)
  1. D A1 ; Line #2
  1. ;
  1. S LPPP=$$MEMCPP^PRSPUT3(MIEN)
  1. S PPP=$P(LPPP,U,2),LPPP=$P(LPPP,U,1)
  1. ; Check to see if last PP certified in #458 is in #459
  1. I LPPP'="",'$D(^PRST(459,"B",LPPP)) S PPP=PPP-1
  1. ; Loop to determine the total hours worked from multiple
  1. F I=1:1:PPP D
  1. . S HRSWK=HRSWK+$$GET1^DIQ(458.701,I_","_MIEN_",",1)
  1. S THRSWK=HRSWK+COHRS+HRSCO ; Adjust for carryover hours
  1. ; Hrs That Should Have Been Worked - has any NP and WP included
  1. S HTSHBW=((AHRS/26)*PPP)-NPHRS-WPHRS
  1. S OTHRS=THRSWK-HTSHBW
  1. S POHC=THRSWK/(AHRS-NPHRS-WPHRS)*100 ; Adjust % or Hrs Completed
  1. ; Only calculate the following if memo has started and not ended
  1. I PPP,PPP<26 D
  1. . I HTSHBW'=THRSWK D ; PTP has worked more or less than Ave Hrs/PP
  1. . . I THRSWK'<(AHRS-NPHRS-WPHRS) S AHTCM=0
  1. . . I THRSWK<(AHRS-NPHRS-WPHRS) S AHTCM=AHRS-THRSWK-NPHRS-WPHRS/(26-PPP)
  1. . . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
  1. . . S POT=THRSWK-POT/POT,POT=POT*100
  1. . I HTSHBW=THRSWK D ; PTP has worked exactly Ave Hrs/PP
  1. . . S AHTCM=AHRS-THRSWK-WPHRS-NPHRS/(26-PPP)
  1. . . S POT=0
  1. I PPP=26 D ; Memo has ended
  1. . S AHTCM=0
  1. . S POT=(AHRS/26*PPP)-WPHRS-NPHRS
  1. . S POT=THRSWK-POT/POT,POT=POT*100
  1. I PPP=0 D ; 1st PP hasn't been processed
  1. . S AHTCM=AHRS-COHRS/26
  1. . S POT=0
  1. I TDAT D
  1. . S $E(TEXT,2)="",TEXT=TEXT_"TERMINATED: "_TDATEX
  1. I TDAT=0 S $E(TEXT,4)="",TEXT=TEXT_"End Date: "_ENDDAT
  1. S $E(TEXT,29,31)="| ",TEXT=TEXT_"Hours Worked: "_$J(HRSWK,7,2)
  1. S $E(TEXT,55,57)="| ",TEXT=TEXT_" Non Pay Hrs: "_$J(NPHRS,7,2)
  1. D A1 ; Line #3
  1. ;
  1. S POMC=PPP_" of 26 PP = "_$J(100*(PPP/26),6,2)_"%"
  1. I PPP<10 S $E(TEXT,6)="",TEXT=TEXT_POMC
  1. I PPP>9 S $E(TEXT,5)="",TEXT=TEXT_POMC
  1. S $E(TEXT,29,30)="| "
  1. S TEXT=TEXT_"Carryover Hrs: "_$J($S(HRSCO:HRSCO,1:COHRS),7,2)
  1. S $E(TEXT,55,57)="| ",TEXT=TEXT_"Off Target Hrs: "_$J(OTHRS,7,2)
  1. D A1 ; Line #4
  1. ;
  1. S TEXT="% Hrs Completed = "_$J(POHC,6,2)_"%"
  1. S $E(TEXT,29,31)="| ",TEXT=TEXT_" Total Hrs: "
  1. S TEXT=TEXT_$J(THRSWK,7,2)
  1. S $E(TEXT,55,57)="| ",TEXT=TEXT_" Off Target %: "_$J(POT,7,2)
  1. D A1 ; Line #5
  1. ;
  1. I PPP<26 D
  1. . S TEXT=(AHRS-NPHRS-WPHRS)-THRSWK,TEXT=TEXT/(26-PPP)
  1. . S TEXT=$FN(TEXT,"",2)
  1. . S TEXT=" Agreement will be met by averaging "_TEXT
  1. . S TEXT=TEXT_" Hrs/PP during remainder of memo."
  1. ;
  1. I PPP=26 D
  1. . S $E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
  1. ;
  1. I TDAT D
  1. . I LPPP'="" D
  1. . . S LPPP=$O(^PRST(458,"B",LPPP,0))
  1. . . S LPPP=$P($G(^PRST(458,LPPP,1)),U,14)
  1. . . I TDAT'>LPPP D Q
  1. . . . S TEXT="",$E(TEXT,30)="",TEXT=TEXT_"This memorandum has ended"
  1. ;
  1. D A1 ; Line #6
  1. K INDEX,Y
  1. Q
  1. ;
  1. A1 ; Set TEXT into the array
  1. ;
  1. N A1
  1. W !,TEXT
  1. I $G(ARRAY)'="" D
  1. . S A1="S "_ARRAY_INDEX_")="_""""_TEXT_""""
  1. . X A1
  1. . S INDEX=INDEX+1
  1. S TEXT=""
  1. Q
  1. ;
  1. INDEX ; Get last index in array if not passed in
  1. ;
  1. S INDEX="S INDEX=$O("_ARRAY_"""A""),-1)"
  1. X INDEX
  1. I 'INDEX S INDEX=1 Q
  1. I INDEX S INDEX=INDEX+1
  1. Q