PRSPUT2 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #2 ;07/08/2005
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;The following routine contains various utilities for the Part Time
;Physician functionality that was added as part of patch PRS*4.0*93.
;
;-----------------------------------------------------------------------
; Display information on the hours worked by the PT Physician per PP
; Input: PRSIEN - IEN of the PT Physician
; MIEN - IEN of the PT Phy's memorandum in #458.7
; ARRAY - The array where the message to be printed will be
; stored. (Optional) If not specified, no array will
; be created.
; INDEX - The index where the array will start. (optional) This
; will be set to 1 if no index is passed.
;
; Output: 6 line summary of the Pay Periods covered by the PT Phy's
; memorandum and the hours worked during each of them.
; Array with the same data if the ARRAY parameter is passed.
;-----------------------------------------------------------------------
PPSUM(PRSIEN,MIEN,ARRAY,INDEX) ;
;
Q:'PRSIEN&('MIEN)
I $G(INDEX)="",($G(ARRAY)'="") D INDEX^PRSPUT1
N I,J,PPHRS,PPNUM,TEXT
S TEXT=""
D A1^PRSPUT1 ; Blank Line
F I=1:1:6 D
. S TEXT=" "
. F J=I:6:26 D
. . S PPNUM=$$GET1^DIQ(458.701,J_","_MIEN_",",.01)_": "
. . S TEXT=TEXT_PPNUM
. . S PPHRS=$$GET1^DIQ(458.701,J_","_MIEN_",",1)
. . S TEXT=TEXT_$S(PPHRS'="":$J(PPHRS,6,2),1:" ")
. . S TEXT=TEXT_$S(J'<25:"",1:" ")
. D A1^PRSPUT1
D A1^PRSPUT1,A1^PRSPUT1 ; 2 Blank lines
Q
;
;----------------------------------------------------------------------
; Retrieve and display the current status of each daily ESR within
; the specified PP
; Input: PRSIEN - IEN of the PT Physician
; PPI - IEN of the Pay Period
;
; Output: 8 lines with the summary of the daily ESRs within the PP
;-----------------------------------------------------------------------
ESRSTAT(PRSIEN,PPI) ;
Q:'PRSIEN&('PPI)
N ATOT,DATA,DAY,DAY2CHK,DAYE,DTEXT,ESRHRS,HRS,I,INDX,J,MEAL,SEG,START
N STATEX,STATUS,STOP,TEXT,TOT
S DAYE=$G(^PRST(458,PPI,2)),(ESRHRS(1),ESRHRS(2))=0
F DAY=1:1:14 D
. S INDX=$S(DAY<8:1,1:2)
. S DATA=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
. F SEG=1:5:31 D
. . S START=$P(DATA,U,SEG),STOP=$P(DATA,U,SEG+1),TOT=$P(DATA,U,SEG+2)
. . Q:START=""
. . Q:TOT="WP" ; Don't count Without Pay
. . S MEAL=$P(DATA,U,SEG+4)
. . S HRS=$$AMT^PRSPSAPU(START,STOP,MEAL)
. . S ESRHRS(INDX)=ESRHRS(INDX)+HRS
S TEXT=" ESR Hours Week 1: "_$J(ESRHRS(1),6,2)
S TEXT=TEXT_" Week 2: "_$J(ESRHRS(2),6,2)
S TEXT=TEXT_" Total: "_$J(ESRHRS(1)+ESRHRS(2),6,2)
W !,TEXT
W !,"Day Week 1 - ",$P(DAYE,U,1),?41,"Day Week 2 - ",$P(DAYE,U,8)
; Loop through each daily ESR record
F DAY=1:1:7 D
. S DAY2CHK=DAY D ATOT
. S $E(DTEXT,42)=""
. S TEXT=DTEXT
. S DAY2CHK=DAY2CHK+7 D ATOT
. S TEXT=TEXT_DTEXT
. W !,TEXT
Q
;
ATOT ; Convert STATUS to external and determine Types of Time posted
S ATOT="" ; All Types Of Time posted on the day
S STATUS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,7)),U,1)
S STATEX=$$EXTERNAL^DILFD(458.02,146,"",STATUS)
S DATA=$G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,5))
S DTEXT=$S(DAY2CHK<10:" "_DAY2CHK,1:DAY2CHK)
S DTEXT=DTEXT_" "_$E($P(DAYE,U,DAY),1,3)_" "_STATEX
I DATA'="" D
. F SEG=0:1:6 Q:$P(DATA,U,5*SEG+1)="" D
. . S TOT=$P(DATA,U,5*SEG+3)
. . I TOT'=""&(ATOT'[TOT) S ATOT=$S(ATOT="":TOT,1:ATOT_", "_TOT)
; If status is RESUBMIT check for Supervisor text
N SUPCOM
S SUPCOM=""
I STATUS=3 D
. S SUPCOM=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,6)),U,2)
. I SUPCOM'="" S ATOT=" "_SUPCOM
I "^2^4^5^"[("^"_STATUS_"^") S $E(DTEXT,19,20)="- "
I STATUS=3,SUPCOM="" S $E(DTEXT,19,20)="- "
S DTEXT=DTEXT_ATOT
Q
;
PRSIEN(MSGF) ; Employee IEN Extrinsic Function
; input
; MSGF - (optional) message flag, true (=1) to write error message
; DUZ - must be defined in symbol table
; returns IEN in file 450 or null
N PRSIEN,SSN
S PRSIEN=""
S SSN=$P($G(^VA(200,DUZ,1)),"^",9)
S:SSN'="" PRSIEN=$O(^PRSPC("SSN",SSN,0))
I 'PRSIEN,$G(MSGF) W $C(7),!!,"Your SSN was not found in both the New Person & Employee File!"
Q PRSIEN
;
ESIGC(MSGF) ; Electronic Signature Code Extrinsic Function
; input
; MSGF - (optional) message flag, true (=1) to write error message
; DUZ - must be defined in symbol table
; returns true (=1) if the user has an electronic signature code
; false (=0) if the user does not
N PRSRET
S PRSRET=($$GET1^DIQ(200,DUZ_",",20.4)'="")
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."
Q PRSRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPUT2 4918 printed Oct 16, 2024@18:29:06 Page 2
PRSPUT2 ;WOIFO/MGD - PART TIME PHYSICIAN UTILITIES #2 ;07/08/2005
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;The following routine contains various utilities for the Part Time
+5 ;Physician functionality that was added as part of patch PRS*4.0*93.
+6 ;
+7 ;-----------------------------------------------------------------------
+8 ; Display information on the hours worked by the PT Physician per PP
+9 ; Input: PRSIEN - IEN of the PT Physician
+10 ; MIEN - IEN of the PT Phy's memorandum in #458.7
+11 ; ARRAY - The array where the message to be printed will be
+12 ; stored. (Optional) If not specified, no array will
+13 ; be created.
+14 ; INDEX - The index where the array will start. (optional) This
+15 ; will be set to 1 if no index is passed.
+16 ;
+17 ; Output: 6 line summary of the Pay Periods covered by the PT Phy's
+18 ; memorandum and the hours worked during each of them.
+19 ; Array with the same data if the ARRAY parameter is passed.
+20 ;-----------------------------------------------------------------------
PPSUM(PRSIEN,MIEN,ARRAY,INDEX) ;
+1 ;
+2 if 'PRSIEN&('MIEN)
QUIT
+3 IF $GET(INDEX)=""
IF ($GET(ARRAY)'="")
DO INDEX^PRSPUT1
+4 NEW I,J,PPHRS,PPNUM,TEXT
+5 SET TEXT=""
+6 ; Blank Line
DO A1^PRSPUT1
+7 FOR I=1:1:6
Begin DoDot:1
+8 SET TEXT=" "
+9 FOR J=I:6:26
Begin DoDot:2
+10 SET PPNUM=$$GET1^DIQ(458.701,J_","_MIEN_",",.01)_": "
+11 SET TEXT=TEXT_PPNUM
+12 SET PPHRS=$$GET1^DIQ(458.701,J_","_MIEN_",",1)
+13 SET TEXT=TEXT_$SELECT(PPHRS'="":$JUSTIFY(PPHRS,6,2),1:" ")
+14 SET TEXT=TEXT_$SELECT(J'<25:"",1:" ")
End DoDot:2
+15 DO A1^PRSPUT1
End DoDot:1
+16 ; 2 Blank lines
DO A1^PRSPUT1
DO A1^PRSPUT1
+17 QUIT
+18 ;
+19 ;----------------------------------------------------------------------
+20 ; Retrieve and display the current status of each daily ESR within
+21 ; the specified PP
+22 ; Input: PRSIEN - IEN of the PT Physician
+23 ; PPI - IEN of the Pay Period
+24 ;
+25 ; Output: 8 lines with the summary of the daily ESRs within the PP
+26 ;-----------------------------------------------------------------------
ESRSTAT(PRSIEN,PPI) ;
+1 if 'PRSIEN&('PPI)
QUIT
+2 NEW ATOT,DATA,DAY,DAY2CHK,DAYE,DTEXT,ESRHRS,HRS,I,INDX,J,MEAL,SEG,START
+3 NEW STATEX,STATUS,STOP,TEXT,TOT
+4 SET DAYE=$GET(^PRST(458,PPI,2))
SET (ESRHRS(1),ESRHRS(2))=0
+5 FOR DAY=1:1:14
Begin DoDot:1
+6 SET INDX=$SELECT(DAY<8:1,1:2)
+7 SET DATA=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,5))
+8 FOR SEG=1:5:31
Begin DoDot:2
+9 SET START=$PIECE(DATA,U,SEG)
SET STOP=$PIECE(DATA,U,SEG+1)
SET TOT=$PIECE(DATA,U,SEG+2)
+10 if START=""
QUIT
+11 ; Don't count Without Pay
if TOT="WP"
QUIT
+12 SET MEAL=$PIECE(DATA,U,SEG+4)
+13 SET HRS=$$AMT^PRSPSAPU(START,STOP,MEAL)
+14 SET ESRHRS(INDX)=ESRHRS(INDX)+HRS
End DoDot:2
End DoDot:1
+15 SET TEXT=" ESR Hours Week 1: "_$JUSTIFY(ESRHRS(1),6,2)
+16 SET TEXT=TEXT_" Week 2: "_$JUSTIFY(ESRHRS(2),6,2)
+17 SET TEXT=TEXT_" Total: "_$JUSTIFY(ESRHRS(1)+ESRHRS(2),6,2)
+18 WRITE !,TEXT
+19 WRITE !,"Day Week 1 - ",$PIECE(DAYE,U,1),?41,"Day Week 2 - ",$PIECE(DAYE,U,8)
+20 ; Loop through each daily ESR record
+21 FOR DAY=1:1:7
Begin DoDot:1
+22 SET DAY2CHK=DAY
DO ATOT
+23 SET $EXTRACT(DTEXT,42)=""
+24 SET TEXT=DTEXT
+25 SET DAY2CHK=DAY2CHK+7
DO ATOT
+26 SET TEXT=TEXT_DTEXT
+27 WRITE !,TEXT
End DoDot:1
+28 QUIT
+29 ;
ATOT ; Convert STATUS to external and determine Types of Time posted
+1 ; All Types Of Time posted on the day
SET ATOT=""
+2 SET STATUS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,7)),U,1)
+3 SET STATEX=$$EXTERNAL^DILFD(458.02,146,"",STATUS)
+4 SET DATA=$GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,5))
+5 SET DTEXT=$SELECT(DAY2CHK<10:" "_DAY2CHK,1:DAY2CHK)
+6 SET DTEXT=DTEXT_" "_$EXTRACT($PIECE(DAYE,U,DAY),1,3)_" "_STATEX
+7 IF DATA'=""
Begin DoDot:1
+8 FOR SEG=0:1:6
if $PIECE(DATA,U,5*SEG+1)=""
QUIT
Begin DoDot:2
+9 SET TOT=$PIECE(DATA,U,5*SEG+3)
+10 IF TOT'=""&(ATOT'[TOT)
SET ATOT=$SELECT(ATOT="":TOT,1:ATOT_", "_TOT)
End DoDot:2
End DoDot:1
+11 ; If status is RESUBMIT check for Supervisor text
+12 NEW SUPCOM
+13 SET SUPCOM=""
+14 IF STATUS=3
Begin DoDot:1
+15 SET SUPCOM=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY2CHK,6)),U,2)
+16 IF SUPCOM'=""
SET ATOT=" "_SUPCOM
End DoDot:1
+17 IF "^2^4^5^"[("^"_STATUS_"^")
SET $EXTRACT(DTEXT,19,20)="- "
+18 IF STATUS=3
IF SUPCOM=""
SET $EXTRACT(DTEXT,19,20)="- "
+19 SET DTEXT=DTEXT_ATOT
+20 QUIT
+21 ;
PRSIEN(MSGF) ; Employee IEN Extrinsic Function
+1 ; input
+2 ; MSGF - (optional) message flag, true (=1) to write error message
+3 ; DUZ - must be defined in symbol table
+4 ; returns IEN in file 450 or null
+5 NEW PRSIEN,SSN
+6 SET PRSIEN=""
+7 SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
+8 if SSN'=""
SET PRSIEN=$ORDER(^PRSPC("SSN",SSN,0))
+9 IF 'PRSIEN
IF $GET(MSGF)
WRITE $CHAR(7),!!,"Your SSN was not found in both the New Person & Employee File!"
+10 QUIT PRSIEN
+11 ;
ESIGC(MSGF) ; Electronic Signature Code Extrinsic Function
+1 ; input
+2 ; MSGF - (optional) message flag, true (=1) to write error message
+3 ; DUZ - must be defined in symbol table
+4 ; returns true (=1) if the user has an electronic signature code
+5 ; false (=0) if the user does not
+6 NEW PRSRET
+7 SET PRSRET=($$GET1^DIQ(200,DUZ_",",20.4)'="")
+8 IF 'PRSRET
IF $GET(MSGF)
WRITE $CHAR(7),!!,"You must establish an electronic signature code before using this option!",!,"This can be done with the 'Electronic Signature code Edit' option."
+9 QUIT PRSRET
