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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPESR1 9206 printed Apr 09, 2024@21:29:15 Page 2
PRSPESR1 ;WOIFO/JAH - part time physicians ESR Edit ;11/04/04
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
ESRFRM(PRSIEN,PPI,PRSD) ;Run ScreenMan Form PRSA ESR EDIT on file 458
+1 ;
+2 NEW TOD,TOD2,TOUR,STAT,GLOB,PRSN1,PRSN2,PRSN4,PRSN5,PRSN6,Y31,PRSDTE
+3 NEW MLALLOW,PRSML,PRSML2,DFN,Z,ZENT,DIE,DA,DDSFILE,STOP,Z
+4 ;
+5 SET STAT=$$GETSTAT(PRSIEN,PPI,PRSD)
+6 SET TOD=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
+7 SET TOD2=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,13)
+8 ; NODES THAT WE MAY EDIT IN THE FORM
+9 ; tour segmts
SET PRSN1=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
+10 ; 2nd tour
SET PRSN4=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4))
+11 ; esr wrk
SET PRSN5=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
+12 ; daily esr remrks
SET PRSN6=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,6))
+13 ;
+14 ; get ALL TOUR SGMNTS + meal for display
+15 ;
+16 SET Y31=$$GETTOUR^PRSPESR3(PRSIEN,PRSD,TOD,PRSN1,PRSN4)
+17 SET PRSML=$PIECE($GET(^PRST(457.1,TOD,0)),U,3)
+18 SET MLALLOW=60
+19 ;
+20 ; If second tour, have meal time handy
+21 IF $GET(TOD2)>0
Begin DoDot:1
+22 SET PRSML2=$PIECE($GET(^PRST(457.1,TOD2,0)),U,3)
+23 SET MLALLOW=120
End DoDot:1
+24 ;
+25 SET PRSDTE=$PIECE($GET(^PRST(458,PPI,2)),U,PRSD)
+26 ;
+27 ; DFN needed for old call to lock record.
+28 SET DFN=PRSIEN
IF '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP)
QUIT
+29 ; ScreenMan
+30 SET DDSFILE=458
SET DDSFILE(1)=458.02
SET DA(2)=PPI
SET DA(1)=PRSIEN
SET DA=PRSD
+31 SET Z=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
+32 ;
+33 ; allowed types of time for ESR
+34 ; days off only allow RG
+35 SET ZENT=$SELECT(Y31="Day Off":"RG",1:"RG AL AA DL ML HX CP RL SL CB AD WP TV TR")
+36 SET DR="[PRSP ESR POST]"
DO ^DDS
+37 ;
+38 ; remove blank rows from ESR
+39 SET Z=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
+40 SET ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)=$$BURP^PRSPESR2(Z)
+41 if GLOB]""
DO UNLOCK^PRSLIB00(GLOB)
+42 QUIT
+43 ;
GETSTAT(PRSIEN,PPI,PRSD) ; func return status
+1 ; esr daily status (#146) 1:NOT STARTED;2:PENDING;3:RESUBMIT;
+2 ; 4:SIGNED;5:APPROVED;6:DAY OFF
+3 QUIT $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),"^",1)
+4 ;
ESRVALID ; Validate Daily ESR data
+1 ; called when PTP attempts to save ScrMn form PRSP ESR POST (F458)
+2 ; DDSERROR set to prevent save.
+3 ; DDSBR set takes user field
+4 ;
+5 ; Z - combo: global time segs + form edits.
+6 ;
+7 ; If data unchanged, skip validation and esig
+8 ; But if status = Pend OR Resub, PTP may sign even if data unchanged.
+9 NEW STR,WARNING
+10 IF $GET(Z)'=""
IF $GET(Z)=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
IF STAT'=2
IF STAT'=3
Begin DoDot:1
+11 DO MSG^DDSUTL("...No edits to save")
End DoDot:1
QUIT
+12 ;
+13 ; If DDSERROR (bad user data), return to ScreenMan
+14 DO CHKDATA
+15 if $GET(DDSERROR)
QUIT
+16 ;
+17 ; display warning if any are found but don't stop user from signing
+18 IF $GET(WARNING)
DO WARNMSG^PRSPESR3(STR)
+19 ;
+20 ; If user hits return at sign prompt, save as pending
+21 ; If user types "^" don't save changes
+22 ; If user signs, save.
+23 ;
+24 NEW X1
+25 DO SIG^XUSESIG
+26 IF X1=""
Begin DoDot:1
+27 NEW PRSMSG
+28 SET PRSMSG="CANCEL: ESR day changes were not saved."
+29 IF $GET(X)="^"
Begin DoDot:2
+30 SET DDSERROR=1
+31 DO MSG^DDSUTL(PRSMSG)
End DoDot:2
+32 IF '$TEST
Begin DoDot:2
+33 NEW DIE,DR,DA
+34 SET DA(2)=$GET(PPI)
SET DA(1)=$GET(PRSIEN)
SET DA=$GET(PRSD)
+35 ; if status is resubmit and they didn't sign then leave it resubmit
+36 IF STAT=3
Begin DoDot:3
+37 SET DR="146///RESUBMIT;149///MANUAL POST"
+38 SET PRSMSG="RESUBMIT: changes saved w/out signature, but status remains Resubmit."
End DoDot:3
+39 IF '$TEST
Begin DoDot:3
+40 SET DR="146///PENDING;149///MANUAL POST"
+41 SET PRSMSG="PENDING: ESR day changes saved w/out signature."
+42 ; form global var ESR DAILY STATUS gets PENDING
SET STAT=2
End DoDot:3
+43 SET DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
+44 DO ^DIE
+45 ; reset X since it's saved to dataBse.
KILL X
+46 DO MSG^DDSUTL(PRSMSG)
End DoDot:2
End DoDot:1
+47 IF '$TEST
Begin DoDot:1
+48 ; update ESR DAILY STATUS and ESR LAST SIGN METHOD
+49 NEW PRSFDA,IENS,STAMP
+50 SET STAMP=$$NOW^XLFDT()
+51 ;
+52 SET IENS=PRSD_","_PRSIEN_","_PPI_","
+53 SET PRSFDA(458.02,IENS,146)=4
+54 SET PRSFDA(458.02,IENS,147)=STAMP
+55 SET PRSFDA(458.02,IENS,149)=1
+56 DO FILE^DIE("","PRSFDA")
+57 DO MSG^DIALOG()
+58 ;
+59 ; reset X, it's saved to database.
KILL X
+60 ; form global var ESR DAILY STATUS gets SIGNED
SET STAT=4
+61 DO MSG^DDSUTL("SIGNED: ESR data saved with signature.")
End DoDot:1
+62 QUIT
+63 ;
CHKDATA ; called to validate screenman posting on ESR daily
+1 ;
+2 ; Z initialized to data that appears on the unedited form.
+3 ; when a field on ScreenMan form changes the appropriate piece
+4 ; of Z is updated in the post action change field in ScreenMan.
+5 ; so Z contains the original data for a day plus any changes that
+6 ; the user is trying to save.
+7 ; each 5 pieces of z hold START, STOP, TYPE OF TIME, REMARKS, MEAL
+8 ;
+9 NEW T,K,ZS,NOTHING,MLP,DY2,MTOT,TWO,Z1,Z2,Y
+10 SET ZS=""
+11 ;
+12 ; 2 day tour?
+13 SET TWO=$PIECE($GET(^PRST(457.1,+TOD,0)),U,5)
+14 SET DY2=TWO="Y"
+15 IF TOD2
IF 'DY2
SET TWO=$PIECE($GET(^PRST(457.1,+TOD2,0)),U,5)
SET DY2=TWO="Y"
+16 ;
+17 ;loop thru 5 columns, 7 time segments
+18 ; quit if we encounter an error
+19 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:1
+20 ;
+21 ; if absolutely nothing on any segments in the row or just a zero
+22 ; in meal column then skip row.
+23 ;
+24 SET NOTHING=(($PIECE(Z,U,K)="")&($PIECE(Z,U,K+1)="")&($PIECE(Z,U,K+2)="")&($PIECE(Z,U,K+3)="")&(($PIECE(Z,U,K+4)="")!($PIECE(Z,U,K+4)=0)))
+25 if NOTHING
QUIT
+26 ;
+27 ; missing start or stop
+28 IF $PIECE(Z,U,K)=""!($PIECE(Z,U,K+1)="")
DO E8
SET DDSERROR=1
QUIT
+29 ;
+30 ; 2nd day posting on 1 day tour (ALLOW RG POSTING ACROSS MID)
+31 SET X=$PIECE(Z,U,K)_U_$PIECE(Z,U,K+1)
+32 DO CNV^PRSATIM
SET Z1=$PIECE(Y,U,1)
SET Z2=$PIECE(Y,U,2)
+33 DO V0^PRSATP1
+34 IF Z2>1440
IF TWO'="Y"
IF "RG OT CT SB ON UA"'[$PIECE(Z,U,K+2)
Begin DoDot:2
+35 DO E4
+36 SET DDSERROR=1
End DoDot:2
QUIT
+37 ;
+38 ; posted more than 48 hrs (2880 min)
+39 IF Z2>2880
DO E5
SET DDSERROR=1
QUIT
+40 ;
+41 ; no type of time
+42 IF $PIECE(Z,U,K+2)=""
DO E9
SET DDSERROR=1
QUIT
+43 ;
+44 IF '(Z["HX"&("ON HW"[$PIECE(Z,U,K+2)))
IF '(Z["^ON"&(Z["OT"))
IF '(Z["^ON"&(Z["CT"))
IF $DATA(T(Z1))
SET DDSERROR=1
DO E3
QUIT
+45 IF $PIECE(Z,U,K+2)="HW"
IF Z'["HX"
IF '$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,12)
SET DDSERROR=1
DO E7
QUIT
+46 IF $PIECE(Z,U,K+2)'=""
SET T(Z1,K)=Z2_U_$PIECE(Z,U,K,K+3)
End DoDot:1
+47 ;
+48 ; T: 1st subscript is start time (minutes from midnight)
+49 ; 2nd subsc is segment number on form (or in Z var)
+50 ; piece 1 stop time in minutes from midnight.
+51 ; for 3 segment postings will look like the following:
+52 ; T(945,1)=1140^03:45P^07:00P^RG^
+53 ; T(1140,6)=1305^07:00P^09:45P^RG^
+54 ; T(1320,11)=1380^10:00P^11:00P^RG
+55 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+56 IF '$DATA(T)
QUIT
+57 ;
+58 ; segment overlap
+59 IF Z'["HX"
IF '(Z["^ON"&(Z["OT"))
IF '(Z["^ON"&(Z["CT"))
Begin DoDot:1
+60 SET Z1=""
+61 FOR
SET Z1=$ORDER(T(Z1))
if Z1=""!($GET(DDSERROR))
QUIT
Begin DoDot:2
+62 IF Z1'<T(Z1,$ORDER(T(Z1,0)))
Begin DoDot:3
+63 DO E1
+64 SET DDSERROR=1
End DoDot:3
+65 IF '$TEST
Begin DoDot:3
+66 SET Y=$ORDER(T(Z1))
+67 IF Y
IF T(Z1,$ORDER(T(Z1,0)))>Y
SET DDSERROR=1
DO E2
End DoDot:3
End DoDot:2
End DoDot:1
+68 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+69 ;
+70 ; leave outside time segments
+71 IF $$VALIDLV^PRSPESR2(PRSN1,.T)
IF $$VALIDLV^PRSPESR2(PRSN4,.T)
SET DDSERROR=1
DO E14
DO HLP^DDSUTL(.STR)
QUIT
+72 ;
+73 SET Z1=$$GET^DDSVAL(DIE,.DA,145)
+74 ;
+75 ; make sure we have some txt in remarks field when required
+76 IF Z1=""
Begin DoDot:1
+77 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:2
+78 IF $PIECE(Z,U,K+2)="AA"
DO E6
SET DDSERROR=1
QUIT
+79 IF $PIECE(Z,U,K+2)="WP"
IF $PIECE(Z,U,K+3)=3
DO E10
SET DDSERROR=1
QUIT
End DoDot:2
End DoDot:1
+80 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+81 ;
+82 ; check for too much total meal for whole day
+83 SET MTOT=0
+84 FOR K=1:5:31
SET MTOT=MTOT+$PIECE(Z,U,K+4)
+85 IF MTOT>MLALLOW
DO E15
SET DDSERROR=1
DO HLP^DDSUTL(.STR)
QUIT
+86 ;
+87 ; check for too much meal on any segment
+88 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:1
+89 SET MLP=$PIECE(Z,U,K+4)
+90 IF MLP>0
Begin DoDot:2
+91 NEW WORK
SET WORK=$$ELAPSE^PRSPESR2(MLP,$PIECE(Z,U,K),$PIECE(Z,U,K+1))
+92 IF $EXTRACT(WORK,1,1)="-"!(WORK="00:00")!(WORK=0)
DO E17
SET DDSERROR=1
End DoDot:2
End DoDot:1
+93 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+94 ;
+95 ; check for comptime earned and used w/out remarks
+96 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:1
+97 IF ($PIECE(Z,U,K+2)="CT")&($PIECE(Z,U,K+3)="")
DO E11
SET DDSERROR=1
End DoDot:1
+98 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+99 ;
+100 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:1
+101 IF ($PIECE(Z,U,K+2)="CU")&($PIECE(Z,U,K+3)="")
DO E12
SET DDSERROR=1
End DoDot:1
+102 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+103 ;
+104 ;make sure compressed tours don't post credit hrs remarks.
+105 IF $$COMPR^PRSATP1(PPI,DFN)
Begin DoDot:1
+106 FOR K=1:5:31
if $GET(DDSERROR)
QUIT
Begin DoDot:2
+107 IF $$CTCH^PRSATP1(Z,K)
DO E13
SET DDSERROR=1
End DoDot:2
End DoDot:1
+108 IF $GET(DDSERROR)
DO HLP^DDSUTL(.STR)
QUIT
+109 QUIT
E1 SET STR="A start time is not less than a stop time."
QUIT
E2 SET STR="End of one segment must not be greater than start of next."
QUIT
E3 SET STR="Duplicate start times encountered."
QUIT
E4 SET STR="Segment of second day encountered; no two-day tour specified."
QUIT
E5 SET STR="Segment of third day encountered."
QUIT
E6 SET STR="Remarks must be entered when AA is posted."
QUIT
E7 SET STR="HW can only be posted with HX or on a Holiday."
QUIT
E8 SET STR="Start or Stop Time not entered for a segment."
QUIT
E9 SET STR="Type of Time not entered for a segment."
QUIT
E10 SET STR="Remarks must be entered for WP due to AWOL."
QUIT
E11 SET STR="REMARKS CODE must be entered when CT is posted."
QUIT
E12 SET STR="REMARKS CODE must be entered when CU is posted."
QUIT
E13 SET STR="REMARKS CODE: Compressed tours can't earn credit hours."
QUIT
E14 SET STR="Leave cannot be posted outside tour."
QUIT
E15 SET STR="Meal time cannot exceed "_MLALLOW_" minutes."
QUIT
E16 SET 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 SET STR="Meal time must be less than time on the segment it is posted with."
QUIT
+1 QUIT
