246 lines
8.8 KiB
Mathematica
246 lines
8.8 KiB
Mathematica
PRSPESR1 ;WOIFO/JAH - part time physicians ESR Edit ;11/04/04
|
|
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;
|
|
ESRFRM(PRSIEN,PPI,PRSD) ;Run ScreenMan Form PRSA ESR EDIT on file 458
|
|
;
|
|
N TOD,TOD2,TOUR,STAT,GLOB,PRSN1,PRSN2,PRSN4,PRSN5,PRSN6,Y31,PRSDTE
|
|
N MLALLOW,PRSML,PRSML2,DFN,Z,ZENT,DIE,DA,DDSFILE,STOP,Z
|
|
;
|
|
S STAT=$$GETSTAT(PRSIEN,PPI,PRSD)
|
|
S TOD=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
|
|
S TOD2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,13)
|
|
; NODES THAT WE MAY EDIT IN THE FORM
|
|
S PRSN1=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1)) ; tour segmts
|
|
S PRSN4=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4)) ; 2nd tour
|
|
S PRSN5=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)) ; esr wrk
|
|
S PRSN6=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,6)) ; daily esr remrks
|
|
;
|
|
; get ALL TOUR SGMNTS + meal for display
|
|
;
|
|
S Y31=$$GETTOUR^PRSPESR3(PRSIEN,PRSD,TOD,PRSN1,PRSN4)
|
|
S PRSML=$P($G(^PRST(457.1,TOD,0)),U,3)
|
|
S MLALLOW=60
|
|
;
|
|
; If second tour, have meal time handy
|
|
I $G(TOD2)>0 D
|
|
. S PRSML2=$P($G(^PRST(457.1,TOD2,0)),U,3)
|
|
. S MLALLOW=120
|
|
;
|
|
S PRSDTE=$P($G(^PRST(458,PPI,2)),U,PRSD)
|
|
;
|
|
; DFN needed for old call to lock record.
|
|
S DFN=PRSIEN I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) Q
|
|
; ScreenMan
|
|
S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=PRSIEN,DA=PRSD
|
|
S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|
;
|
|
; allowed types of time for ESR
|
|
; days off only allow RG
|
|
S ZENT=$S(Y31="Day Off":"RG",1:"RG AL AA DL ML HX CP RL SL CB AD WP TV TR")
|
|
S DR="[PRSP ESR POST]" D ^DDS
|
|
;
|
|
; remove blank rows from ESR
|
|
S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|
S ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)=$$BURP^PRSPESR2(Z)
|
|
D:GLOB]"" UNLOCK^PRSLIB00(GLOB)
|
|
Q
|
|
;
|
|
GETSTAT(PRSIEN,PPI,PRSD) ; func return status
|
|
; esr daily status (#146) 1:NOT STARTED;2:PENDING;3:RESUBMIT;
|
|
; 4:SIGNED;5:APPROVED;6:DAY OFF
|
|
Q $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),"^",1)
|
|
;
|
|
ESRVALID ; Validate Daily ESR data
|
|
; called when PTP attempts to save ScrMn form PRSP ESR POST (F458)
|
|
; DDSERROR set to prevent save.
|
|
; DDSBR set takes user field
|
|
;
|
|
; Z - combo: global time segs + form edits.
|
|
;
|
|
; If data unchanged, skip validation and esig
|
|
; But if status = Pend OR Resub, PTP may sign even if data unchanged.
|
|
N STR,WARNING
|
|
I $G(Z)'="",$G(Z)=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)),STAT'=2,STAT'=3 D Q
|
|
. D MSG^DDSUTL("...No edits to save")
|
|
;
|
|
; If DDSERROR (bad user data), return to ScreenMan
|
|
D CHKDATA
|
|
Q:$G(DDSERROR)
|
|
;
|
|
; display warning if any are found but don't stop user from signing
|
|
I $G(WARNING) D WARNMSG^PRSPESR3(STR)
|
|
;
|
|
; If user hits return at sign prompt, save as pending
|
|
; If user types "^" don't save changes
|
|
; If user signs, save.
|
|
;
|
|
N X1
|
|
D SIG^XUSESIG
|
|
I X1="" D
|
|
. N PRSMSG
|
|
. S PRSMSG="CANCEL: ESR day changes were not saved."
|
|
. I $G(X)="^" D
|
|
.. S DDSERROR=1
|
|
.. D MSG^DDSUTL(PRSMSG)
|
|
. E D
|
|
.. N DIE,DR,DA
|
|
.. S DA(2)=$G(PPI),DA(1)=$G(PRSIEN),DA=$G(PRSD)
|
|
..; if status is resubmit and they didn't sign then leave it resubmit
|
|
.. I STAT=3 D
|
|
... S DR="146///RESUBMIT;149///MANUAL POST"
|
|
... S PRSMSG="RESUBMIT: changes saved w/out signature, but status remains Resubmit."
|
|
.. E D
|
|
... S DR="146///PENDING;149///MANUAL POST"
|
|
... S PRSMSG="PENDING: ESR day changes saved w/out signature."
|
|
... S STAT=2 ; form global var ESR DAILY STATUS gets PENDING
|
|
.. S DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
|
|
.. D ^DIE
|
|
.. K X ; reset X since it's saved to dataBse.
|
|
.. D MSG^DDSUTL(PRSMSG)
|
|
E D
|
|
.; update ESR DAILY STATUS and ESR LAST SIGN METHOD
|
|
. N PRSFDA,IENS,STAMP
|
|
. S STAMP=$$NOW^XLFDT()
|
|
.;
|
|
. S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|
. S PRSFDA(458.02,IENS,146)=4
|
|
. S PRSFDA(458.02,IENS,147)=STAMP
|
|
. S PRSFDA(458.02,IENS,149)=1
|
|
. D FILE^DIE("","PRSFDA")
|
|
. D MSG^DIALOG()
|
|
.;
|
|
. K X ; reset X, it's saved to database.
|
|
. S STAT=4 ; form global var ESR DAILY STATUS gets SIGNED
|
|
. D MSG^DDSUTL("SIGNED: ESR data saved with signature.")
|
|
Q
|
|
;
|
|
CHKDATA ; called to validate screenman posting on ESR daily
|
|
;
|
|
; Z initialized to data that appears on the unedited form.
|
|
; when a field on ScreenMan form changes the appropriate piece
|
|
; of Z is updated in the post action change field in ScreenMan.
|
|
; so Z contains the original data for a day plus any changes that
|
|
; the user is trying to save.
|
|
; each 5 pieces of z hold START, STOP, TYPE OF TIME, REMARKS, MEAL
|
|
;
|
|
N T,K,ZS,NOTHING,MLP,DY2,MTOT,TWO,Z1,Z2,Y
|
|
S ZS=""
|
|
;
|
|
; 2 day tour?
|
|
S TWO=$P($G(^PRST(457.1,+TOD,0)),U,5)
|
|
S DY2=TWO="Y"
|
|
I TOD2,'DY2 S TWO=$P($G(^PRST(457.1,+TOD2,0)),U,5),DY2=TWO="Y"
|
|
;
|
|
;loop thru 5 columns, 7 time segments
|
|
; quit if we encounter an error
|
|
F K=1:5:31 Q:$G(DDSERROR) D
|
|
.;
|
|
.; if absolutely nothing on any segments in the row or just a zero
|
|
.; in meal column then skip row.
|
|
.;
|
|
. S NOTHING=(($P(Z,U,K)="")&($P(Z,U,K+1)="")&($P(Z,U,K+2)="")&($P(Z,U,K+3)="")&(($P(Z,U,K+4)="")!($P(Z,U,K+4)=0)))
|
|
. Q:NOTHING
|
|
.;
|
|
.; missing start or stop
|
|
. I $P(Z,U,K)=""!($P(Z,U,K+1)="") D E8 S DDSERROR=1 Q
|
|
.;
|
|
.; 2nd day posting on 1 day tour (ALLOW RG POSTING ACROSS MID)
|
|
. S X=$P(Z,U,K)_U_$P(Z,U,K+1)
|
|
. D CNV^PRSATIM S Z1=$P(Y,U,1),Z2=$P(Y,U,2)
|
|
. D V0^PRSATP1
|
|
. I Z2>1440,TWO'="Y","RG OT CT SB ON UA"'[$P(Z,U,K+2) D Q
|
|
.. D E4
|
|
.. S DDSERROR=1
|
|
.;
|
|
.; posted more than 48 hrs (2880 min)
|
|
. I Z2>2880 D E5 S DDSERROR=1 Q
|
|
.;
|
|
.; no type of time
|
|
. I $P(Z,U,K+2)="" D E9 S DDSERROR=1 Q
|
|
.;
|
|
. I '(Z["HX"&("ON HW"[$P(Z,U,K+2))),'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")),$D(T(Z1)) S DDSERROR=1 D E3 Q
|
|
. I $P(Z,U,K+2)="HW",Z'["HX",'$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,12) S DDSERROR=1 D E7 Q
|
|
. I $P(Z,U,K+2)'="" S T(Z1,K)=Z2_U_$P(Z,U,K,K+3)
|
|
;
|
|
; T: 1st subscript is start time (minutes from midnight)
|
|
; 2nd subsc is segment number on form (or in Z var)
|
|
; piece 1 stop time in minutes from midnight.
|
|
; for 3 segment postings will look like the following:
|
|
; T(945,1)=1140^03:45P^07:00P^RG^
|
|
; T(1140,6)=1305^07:00P^09:45P^RG^
|
|
; T(1320,11)=1380^10:00P^11:00P^RG
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
I '$D(T) Q
|
|
;
|
|
; segment overlap
|
|
I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) D
|
|
. S Z1=""
|
|
. F S Z1=$O(T(Z1)) Q:Z1=""!($G(DDSERROR)) D
|
|
.. I Z1'<T(Z1,$O(T(Z1,0))) D
|
|
... D E1
|
|
... S DDSERROR=1
|
|
.. E D
|
|
... S Y=$O(T(Z1))
|
|
... I Y,T(Z1,$O(T(Z1,0)))>Y S DDSERROR=1 D E2
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
;
|
|
; leave outside time segments
|
|
I $$VALIDLV^PRSPESR2(PRSN1,.T),$$VALIDLV^PRSPESR2(PRSN4,.T) S DDSERROR=1 D E14,HLP^DDSUTL(.STR) Q
|
|
;
|
|
S Z1=$$GET^DDSVAL(DIE,.DA,145)
|
|
;
|
|
; make sure we have some txt in remarks field when required
|
|
I Z1="" D
|
|
. F K=1:5:31 Q:$G(DDSERROR) D
|
|
.. I $P(Z,U,K+2)="AA" D E6 S DDSERROR=1 Q
|
|
.. I $P(Z,U,K+2)="WP",$P(Z,U,K+3)=3 D E10 S DDSERROR=1 Q
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
;
|
|
; check for too much total meal for whole day
|
|
S MTOT=0
|
|
F K=1:5:31 S MTOT=MTOT+$P(Z,U,K+4)
|
|
I MTOT>MLALLOW D E15 S DDSERROR=1 D HLP^DDSUTL(.STR) Q
|
|
;
|
|
; check for too much meal on any segment
|
|
F K=1:5:31 Q:$G(DDSERROR) D
|
|
. S MLP=$P(Z,U,K+4)
|
|
. I MLP>0 D
|
|
.. N WORK S WORK=$$ELAPSE^PRSPESR2(MLP,$P(Z,U,K),$P(Z,U,K+1))
|
|
.. I $E(WORK,1,1)="-"!(WORK="00:00")!(WORK=0) D E17 S DDSERROR=1
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
;
|
|
; check for comptime earned and used w/out remarks
|
|
F K=1:5:31 Q:$G(DDSERROR) D
|
|
. I ($P(Z,U,K+2)="CT")&($P(Z,U,K+3)="") D E11 S DDSERROR=1
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
;
|
|
F K=1:5:31 Q:$G(DDSERROR) D
|
|
. I ($P(Z,U,K+2)="CU")&($P(Z,U,K+3)="") D E12 S DDSERROR=1
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
;
|
|
;make sure compressed tours don't post credit hrs remarks.
|
|
I $$COMPR^PRSATP1(PPI,DFN) D
|
|
. F K=1:5:31 Q:$G(DDSERROR) D
|
|
.. I $$CTCH^PRSATP1(Z,K) D E13 S DDSERROR=1
|
|
I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|
Q
|
|
E1 S STR="A start time is not less than a stop time." Q
|
|
E2 S STR="End of one segment must not be greater than start of next." Q
|
|
E3 S STR="Duplicate start times encountered." Q
|
|
E4 S STR="Segment of second day encountered; no two-day tour specified." Q
|
|
E5 S STR="Segment of third day encountered." Q
|
|
E6 S STR="Remarks must be entered when AA is posted." Q
|
|
E7 S STR="HW can only be posted with HX or on a Holiday." Q
|
|
E8 S STR="Start or Stop Time not entered for a segment." Q
|
|
E9 S STR="Type of Time not entered for a segment." Q
|
|
E10 S STR="Remarks must be entered for WP due to AWOL." Q
|
|
E11 S STR="REMARKS CODE must be entered when CT is posted." Q
|
|
E12 S STR="REMARKS CODE must be entered when CU is posted." Q
|
|
E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." Q
|
|
E14 S STR="Leave cannot be posted outside tour." Q
|
|
E15 S STR="Meal time cannot exceed "_MLALLOW_" minutes." Q
|
|
E16 S STR="Warning: A segment crosses midnight and a subsequent segment appears to be earlier in the day. This is o.k. as long as all start times begin on the selected ESR day."
|
|
E17 S STR="Meal time must be less than time on the segment it is posted with." Q
|
|
Q
|