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

PRSPRM1.m

Go to the documentation of this file. 
  1. PRSPRM1 ;WOIFO/MGD - PTP RECONCILE MEMORANDUM - 1 ;01/29/07
  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 will allow HR to complete the reconciliation
  1.  ; process for a memorandum that has expired or been terminated.
  1.  ;
  1.  Q
  1.  ;
  1. PTPCHK ; Check for Reconciliation info entered by PTP on electronic form
  1.  ;
  1.  S DATA2=$G(^PRST(458.7,MIEN,2))
  1.  S PTPRC=$P(DATA2,U,1),PTPRCOM=$P(DATA2,U,2)
  1.  I PTPRC="" S PTPRCE="" Q
  1.  S PTPRCE=$$RCE(PTPRC)
  1.  S END="",END=$O(MEM(END),-1) ; Find range on options
  1.  F I=1:1:END D  Q:ACTRC=PTPRC
  1.  . S ACTRC=$P($G(MEM(I)),U,2) ; Numerical choice entered by PTP
  1.  S TEXT=""
  1.  D A1^PRSPUT1
  1.  S TEXT="PTP's Reconciliation Choice: "_I_"  "_PTPRCE
  1.  D A1^PRSPUT1
  1.  ; Set this into ^TMP for long messages
  1.  S TEXT="PTP's Reconciliation Comments: "_$E(PTPRCOM,1,48)
  1.  S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  W !,TEXT
  1.  S TEXT=$E(PTPRCOM,49,128),INDEX=INDEX+1
  1.  I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
  1.  S TEXT=$E(PTPRCOM,129,208),INDEX=INDEX+1
  1.  I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
  1.  S TEXT=$E(PTPRCOM,209,240),INDEX=INDEX+1
  1.  I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT W !,TEXT
  1.  S TEXT=""
  1.  D A1^PRSPUT1 ; Blank Line
  1.  Q
  1.  ;
  1. HRRC ; HR Reconciliation Choice
  1.  S END="",END=$O(MEM(END),-1) ; Find range on options
  1.  ; Prompt for Reconciliation Option
  1. RO W !!,"Enter Reconciliation Option: "
  1.  R RO:DTIME
  1.  S RO=$$UPPER^PRSRUTL(RO)
  1.  I RO="" S RO="^"
  1.  Q:RO="^"
  1.  I '$D(MEM(RO)) D  G RO
  1.  . I END>1 D
  1.  . . W !!,"Enter a number between 1 and ",END," or ^ to exit"
  1.  . I END'>1 D
  1.  . . W !!,"Enter 1 or ^ to exit"
  1.  S PTPRCE=$P(MEM(RO),U,1),PTPRC=$P(MEM(RO),U,2)
  1.  W "  "_PTPRCE
  1.  S TEXT="Enter Reconciliation Option: "_RO
  1.  S INDEX=INDEX+1
  1.  S ^TMP($J,"PRSPRM",INDEX)=TEXT,TEXT=""
  1.  S INDEX=INDEX+1
  1.  D A1^PRSPUT1 ; Blank Line
  1.  Q
  1.  ;
  1. PTPRCOM ; Prompt for PTP's Reconciliation Comments if paper form was used
  1.  ;
  1.  Q:PTPRCOM'=""&(PTPRC)  ; PTP didn't enter any reconciliation comments
  1.  W !
  1.  S DIR(0)="FO^1:240^^",DIR("A")="PTP's Reconciliation Comments"
  1.  D ^DIR K DIR
  1.  I PTPRCOM="",(X'=""&(X'="^")) D
  1.  . S PTPHRCOM="PTP/hr: "_X
  1.  . S TEXT="Reconciliation Comments: "_$E(PTPHRCOM,1,48)
  1.  . S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(PTPHRCOM,49,128),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(PTPHRCOM,129,208),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(PTPHRCOM,209,240),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",INDEX=INDEX+1
  1.  . D A1^PRSPUT1 ; Blank Line
  1.  Q
  1.  ;
  1. TRNS ; Transfer hours to current memorandum
  1.  ;
  1.  Q:PTPRC'=2&(PTPRC'=4)
  1.  Q:'NMIEN
  1.  ;
  1.  D MEM^PRSPUT1(PRSIEN,NMIEN)
  1.  D A1^PRSPUT1 ; Blank Line
  1.  ;
  1.  ; Transfer Prompt
  1.  S TPROMPT="Transfer "_$S(OTHRS>0:"+",1:"")_OTHRS_" hours: "
  1.  S DIR(0)="Y"
  1.  S DIR("A")=TPROMPT
  1.  D ^DIR K DIR
  1.  I X="^" D  Q
  1.  . S QUIT=1
  1.  . W !!,"Memorandum will have to be reconciled at a future date."
  1.  S TEXT=TPROMPT_" "_X
  1.  S INDEX=INDEX+1
  1.  S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  S INDEX=INDEX+1,TEXT=""
  1.  D A1^PRSPUT1 ; Blank Line
  1.  ;
  1. CAL ; Calculate results after transfer
  1.  S DATA=$G(^PRST(458.7,NMIEN,0))
  1.  S AHRS=$P(DATA,U,4) ;     AGREED HOURS
  1.  S THRSWK=$P(DATA,U,10) ;  TOTAL HOURS WORKED
  1.  S NPAYHRS=$P(DATA,U,12) ; NONPAY HOURS
  1.  S WPAYHRS=$P(DATA,U,13) ; WITHOUT PAY HOURS
  1.  S POMC=$P(DATA,U,14) ;   PERCENTAGE OF MEMORANDUM COMPLETED
  1.  S POHC=$P(DATA,U,15) ;   PERCENTAGE OF HOURS COMPLETED
  1.  S AHTCM=$P(DATA,U,16) ;  AVERAGE HOURS TO COMPLETE MEMORANDUM
  1.  S POT=$P(DATA,U,17) ;    % OFF TARGET
  1.  ;
  1.  S AAHRS=AHRS-NPAYHRS-WPAYHRS ; AGREED HOURS adjusted for NP and WP
  1.  S I=$P($$MEMCPP^PRSPUT3(NMIEN),U,2) ; Determine # PP already worked
  1.  S PPREM=26-I ; Pay Periods REMaining
  1.  S NTHRSWK=THRSWK+OTHRS   ; New Total Hours Worked
  1.  S NPOHC=$FN(THRSWK/AAHRS,"",2) ; New % Of Hours Completed
  1.  S NAHTCM=(AAHRS-THRSWK)/PPREM ; Average Hours/PP To Complete Memorandum
  1.  S NAHTCM=$FN(NAHTCM,"",2)
  1.  I I>0 D
  1.  . S NPOT=(AHRS/26*I)-NPAYHRS-WPAYHRS
  1.  . S NPOT=THRSWK-NPOT/NPOT,NPOT=NPOT*100,NPOT=$FN(NPOT,"",2)
  1.  I I=0 S NPOT=0
  1.  ;
  1.  ; Display updated Memorandum info
  1.  D MEM^PRSPUT1(PRSIEN,NMIEN,,,OTHRS)
  1.  Q
  1.  ;
  1. HRCOM ; Prompt for HR's final reconciliation comments
  1.  W !
  1.  S DIR(0)="FO^1:240^^",DIR("A")="Enter Final Reconciliation Comments"
  1.  D ^DIR K DIR
  1.  S HRCOM=X
  1.  I HRCOM'=""&(HRCOM'="^") D
  1.  . S TEXT="Enter Final Reconciliation Comments: "_$E(HRCOM,1,44)
  1.  . S INDEX=INDEX+1,^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(HRCOM,44,123),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(HRCOM,124,203),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  . S TEXT="",TEXT=$E(HRCOM,204,240),INDEX=INDEX+1
  1.  . I TEXT'="" S ^TMP($J,"PRSPRM",INDEX)=TEXT
  1.  S TEXT="",INDEX=INDEX+1
  1.  D A1^PRSPUT1 ; Blank Line
  1.  Q
  1.  ;
  1. PRT ; Print form for Chief of Staff approval
  1.  ;
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Print reconciliation for Chief of Staff approval "
  1.  D ^DIR K DIR
  1.  I X="^" S QUIT=1 Q
  1.  Q:X="N"!(X="n")  ; Quit on 2nd pass
  1.  S INDX="",INDX=$O(^TMP($J,"PRSPRM",INDX),-1),INDX=INDX+1
  1.  S ^TMP($J,"PRSPRM",INDX)="",INDX=INDX+1 ; Blank Line
  1.  S $P(DASH,"_",34)="_"
  1.  S TEXT="Chief of Staff signature "_DASH_"  Date "
  1.  S DASH="",$P(DASH,"_",14)="_",TEXT=TEXT_DASH
  1.  S ^TMP($J,"PRSPRM",INDX)=TEXT
  1.  ;
  1.  W !
  1.  K IOP,%ZIS
  1.  S %ZIS("A")="Select Device: ",%ZIS="MQ"
  1.  D ^%ZIS
  1.  I POP D  Q
  1.  . S QUIT=1
  1.  . K %ZIS,IOP
  1.  I $D(IO("Q")) D  Q
  1.  .  S ZTDESC="PRS PTP COMPLETE RECONCILE"
  1.  .  S ZTRTN="PRINT^PRSPRM1"
  1.  .  S ZTSAVE("^TMP($J,""PRSPRM"",")=""
  1.  .  D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
  1.  .  K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1.  .  D HOME^%ZIS
  1.  U IO
  1.  D PRINT^PRSPRM1,^%ZISC
  1.  K %ZIS,IOP
  1.  Q
  1.  ;
  1. ESIG ; Prompt for Electronic Signature and store fields in #458.7
  1.  ;
  1.  N ESOK
  1.  D ^PRSAES
  1.  Q:'ESOK
  1.  ; Set fields when transferring + or - balance
  1.  I PTPRC=2!(PTPRC=4) D
  1.  . S IEN4587=NMIEN_","
  1.  . S PRSFDA(458.7,IEN4587,8)=OTHRS   ; CARRYOVER HOURS
  1.  . S PRSFDA(458.7,IEN4587,14)=+NPOHC  ; % OF HOURS COMPLETED
  1.  . S PRSFDA(458.7,IEN4587,15)=+NAHTCM ; AVE HRS/PP TO COMPLETE MEM
  1.  . S PRSFDA(458.7,IEN4587,16)=+NPOT   ; % OFF TARGET
  1.  . D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
  1.  ; Update the status of the old memorandum
  1.  S IEN4587=MIEN_","
  1.  I PTPRCOM=""&($G(PTPHRCOM)'="") D   ; PTP Reconciliation Comm from paper
  1.  . S PRSFDA(458.7,IEN4587,18)=PTPHRCOM
  1.  S PRSFDA(458.7,IEN4587,19)=DUZ   ; RECONCILED BY
  1.  D NOW^%DTC
  1.  S PRSFDA(458.7,IEN4587,20)=%     ; DATE/TIME RECONCILED
  1.  S PRSFDA(458.7,IEN4587,21)=HRCOM ; HR RECONCILIATION COMMENTS
  1.  S PRSFDA(458.7,IEN4587,5)=4      ; STATUS = RECONCILED
  1.  D UPDATE^DIE("","PRSFDA","IEN4587"),MSG^DIALOG()
  1.  Q
  1.  ;
  1. PRINT ; Print the paper version of the Reconciliation form
  1.  ;
  1.  S INDEX=""
  1.  F  S INDEX=$O(^TMP($J,"PRSPRM",INDEX)) Q:'INDEX  D
  1.  . S TEXT=^TMP($J,"PRSPRM",INDEX)
  1.  . W !,TEXT
  1.  Q
  1.  ;
  1. RCE(PTPRC) ;
  1.  I PTPRC=1 S PTPRCE="No reconciliation needed"
  1.  I PTPRC=2 S PTPRCE="Transfer negative balance"
  1.  I PTPRC=3 S PTPRCE="Pay VA for negative balance"
  1.  I PTPRC=4 S PTPRCE="Transfer positive balance"
  1.  I PTPRC=5 S PTPRCE="Pay Phy for positive balance"
  1.  Q PTPRCE
  1.  ;
  1. KILL ; Clean up variables
  1.  ;
  1.  K ACTRC,AHRCOM,AHRS,AAHRS,AHTCM,AMT,ARRAY,ASK,ASK2,D1,DASH
  1.  K DATA,DATA0,DATA2,DATA4,DATA5,DAY,DIR,DIRUT,END,ENDDAT,ENDSTA
  1.  K ESRSTAT,HRCOM,I,IEN4587,INDEX,INDX,MEM,MIEN,NAHTCM,NMIEN,NPAYHRS
  1.  K NPHRS,NPOHC,NPOMC,NPOT,NTHRSWK,OLDMIEN,OTHRS,OTP,POP,POHC,POMC
  1.  K POT,PPE,PPI,PPEX,PPEX1,PPCNT,PPREM,PRPRCE,PRSAPGM,PRSIEN,PRSFDA
  1.  K PTPHRCOM,PTPRC,PTPRCE,PTPRCOM,QUIT,RATE,RO,SALARY,SCRTTL,SHRCOM
  1.  K SPAA,START,STATUS,STDAT,SSN,TDAT,TDATE,TEXT,THRSWK
  1.  K TPROMPT,WPAYHRS,WPHRS,ZTSAVE,X,Y,%
  1.  K ^TMP($J,"PRSPRM")
  1.  Q