| [613] | 1 | PRSPESR1 ;WOIFO/JAH - part time physicians ESR Edit ;11/04/04
|
|---|
| 2 | ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ESRFRM(PRSIEN,PPI,PRSD) ;Run ScreenMan Form PRSA ESR EDIT on file 458
|
|---|
| 6 | ;
|
|---|
| 7 | N TOD,TOD2,TOUR,STAT,GLOB,PRSN1,PRSN2,PRSN4,PRSN5,PRSN6,Y31,PRSDTE
|
|---|
| 8 | N MLALLOW,PRSML,PRSML2,DFN,Z,ZENT,DIE,DA,DDSFILE,STOP,Z
|
|---|
| 9 | ;
|
|---|
| 10 | S STAT=$$GETSTAT(PRSIEN,PPI,PRSD)
|
|---|
| 11 | S TOD=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,2)
|
|---|
| 12 | S TOD2=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,13)
|
|---|
| 13 | ; NODES THAT WE MAY EDIT IN THE FORM
|
|---|
| 14 | S PRSN1=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1)) ; tour segmts
|
|---|
| 15 | S PRSN4=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4)) ; 2nd tour
|
|---|
| 16 | S PRSN5=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)) ; esr wrk
|
|---|
| 17 | S PRSN6=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,6)) ; daily esr remrks
|
|---|
| 18 | ;
|
|---|
| 19 | ; get ALL TOUR SGMNTS + meal for display
|
|---|
| 20 | ;
|
|---|
| 21 | S Y31=$$GETTOUR^PRSPESR3(PRSIEN,PRSD,TOD,PRSN1,PRSN4)
|
|---|
| 22 | S PRSML=$P($G(^PRST(457.1,TOD,0)),U,3)
|
|---|
| 23 | S MLALLOW=60
|
|---|
| 24 | ;
|
|---|
| 25 | ; If second tour, have meal time handy
|
|---|
| 26 | I $G(TOD2)>0 D
|
|---|
| 27 | . S PRSML2=$P($G(^PRST(457.1,TOD2,0)),U,3)
|
|---|
| 28 | . S MLALLOW=120
|
|---|
| 29 | ;
|
|---|
| 30 | S PRSDTE=$P($G(^PRST(458,PPI,2)),U,PRSD)
|
|---|
| 31 | ;
|
|---|
| 32 | ; DFN needed for old call to lock record.
|
|---|
| 33 | S DFN=PRSIEN I '$$AVAILREC^PRSLIB00("TK",.GLOB,.STOP) Q
|
|---|
| 34 | ; ScreenMan
|
|---|
| 35 | S DDSFILE=458,DDSFILE(1)=458.02,DA(2)=PPI,DA(1)=PRSIEN,DA=PRSD
|
|---|
| 36 | S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|---|
| 37 | ;
|
|---|
| 38 | ; allowed types of time for ESR
|
|---|
| 39 | ; days off only allow RG
|
|---|
| 40 | S ZENT=$S(Y31="Day Off":"RG",1:"RG AL AA DL ML HX CP RL SL CB AD WP TV TR")
|
|---|
| 41 | S DR="[PRSP ESR POST]" D ^DDS
|
|---|
| 42 | ;
|
|---|
| 43 | ; remove blank rows from ESR
|
|---|
| 44 | S Z=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5))
|
|---|
| 45 | S ^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)=$$BURP^PRSPESR2(Z)
|
|---|
| 46 | D:GLOB]"" UNLOCK^PRSLIB00(GLOB)
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | GETSTAT(PRSIEN,PPI,PRSD) ; func return status
|
|---|
| 50 | ; esr daily status (#146) 1:NOT STARTED;2:PENDING;3:RESUBMIT;
|
|---|
| 51 | ; 4:SIGNED;5:APPROVED;6:DAY OFF
|
|---|
| 52 | Q $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,7)),"^",1)
|
|---|
| 53 | ;
|
|---|
| 54 | ESRVALID ; Validate Daily ESR data
|
|---|
| 55 | ; called when PTP attempts to save ScrMn form PRSP ESR POST (F458)
|
|---|
| 56 | ; DDSERROR set to prevent save.
|
|---|
| 57 | ; DDSBR set takes user field
|
|---|
| 58 | ;
|
|---|
| 59 | ; Z - combo: global time segs + form edits.
|
|---|
| 60 | ;
|
|---|
| 61 | ; If data unchanged, skip validation and esig
|
|---|
| 62 | ; But if status = Pend OR Resub, PTP may sign even if data unchanged.
|
|---|
| 63 | N STR,WARNING
|
|---|
| 64 | I $G(Z)'="",$G(Z)=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)),STAT'=2,STAT'=3 D Q
|
|---|
| 65 | . D MSG^DDSUTL("...No edits to save")
|
|---|
| 66 | ;
|
|---|
| 67 | ; If DDSERROR (bad user data), return to ScreenMan
|
|---|
| 68 | D CHKDATA
|
|---|
| 69 | Q:$G(DDSERROR)
|
|---|
| 70 | ;
|
|---|
| 71 | ; display warning if any are found but don't stop user from signing
|
|---|
| 72 | I $G(WARNING) D WARNMSG^PRSPESR3(STR)
|
|---|
| 73 | ;
|
|---|
| 74 | ; If user hits return at sign prompt, save as pending
|
|---|
| 75 | ; If user types "^" don't save changes
|
|---|
| 76 | ; If user signs, save.
|
|---|
| 77 | ;
|
|---|
| 78 | N X1
|
|---|
| 79 | D SIG^XUSESIG
|
|---|
| 80 | I X1="" D
|
|---|
| 81 | . N PRSMSG
|
|---|
| 82 | . S PRSMSG="CANCEL: ESR day changes were not saved."
|
|---|
| 83 | . I $G(X)="^" D
|
|---|
| 84 | .. S DDSERROR=1
|
|---|
| 85 | .. D MSG^DDSUTL(PRSMSG)
|
|---|
| 86 | . E D
|
|---|
| 87 | .. N DIE,DR,DA
|
|---|
| 88 | .. S DA(2)=$G(PPI),DA(1)=$G(PRSIEN),DA=$G(PRSD)
|
|---|
| 89 | ..; if status is resubmit and they didn't sign then leave it resubmit
|
|---|
| 90 | .. I STAT=3 D
|
|---|
| 91 | ... S DR="146///RESUBMIT;149///MANUAL POST"
|
|---|
| 92 | ... S PRSMSG="RESUBMIT: changes saved w/out signature, but status remains Resubmit."
|
|---|
| 93 | .. E D
|
|---|
| 94 | ... S DR="146///PENDING;149///MANUAL POST"
|
|---|
| 95 | ... S PRSMSG="PENDING: ESR day changes saved w/out signature."
|
|---|
| 96 | ... S STAT=2 ; form global var ESR DAILY STATUS gets PENDING
|
|---|
| 97 | .. S DIE="^PRST(458,"_DA(2)_",""E"","_DA(1)_",""D"","
|
|---|
| 98 | .. D ^DIE
|
|---|
| 99 | .. K X ; reset X since it's saved to dataBse.
|
|---|
| 100 | .. D MSG^DDSUTL(PRSMSG)
|
|---|
| 101 | E D
|
|---|
| 102 | .; update ESR DAILY STATUS and ESR LAST SIGN METHOD
|
|---|
| 103 | . N PRSFDA,IENS,STAMP
|
|---|
| 104 | . S STAMP=$$NOW^XLFDT()
|
|---|
| 105 | .;
|
|---|
| 106 | . S IENS=PRSD_","_PRSIEN_","_PPI_","
|
|---|
| 107 | . S PRSFDA(458.02,IENS,146)=4
|
|---|
| 108 | . S PRSFDA(458.02,IENS,147)=STAMP
|
|---|
| 109 | . S PRSFDA(458.02,IENS,149)=1
|
|---|
| 110 | . D FILE^DIE("","PRSFDA")
|
|---|
| 111 | . D MSG^DIALOG()
|
|---|
| 112 | .;
|
|---|
| 113 | . K X ; reset X, it's saved to database.
|
|---|
| 114 | . S STAT=4 ; form global var ESR DAILY STATUS gets SIGNED
|
|---|
| 115 | . D MSG^DDSUTL("SIGNED: ESR data saved with signature.")
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | CHKDATA ; called to validate screenman posting on ESR daily
|
|---|
| 119 | ;
|
|---|
| 120 | ; Z initialized to data that appears on the unedited form.
|
|---|
| 121 | ; when a field on ScreenMan form changes the appropriate piece
|
|---|
| 122 | ; of Z is updated in the post action change field in ScreenMan.
|
|---|
| 123 | ; so Z contains the original data for a day plus any changes that
|
|---|
| 124 | ; the user is trying to save.
|
|---|
| 125 | ; each 5 pieces of z hold START, STOP, TYPE OF TIME, REMARKS, MEAL
|
|---|
| 126 | ;
|
|---|
| 127 | N T,K,ZS,NOTHING,MLP,DY2,MTOT,TWO,Z1,Z2,Y
|
|---|
| 128 | S ZS=""
|
|---|
| 129 | ;
|
|---|
| 130 | ; 2 day tour?
|
|---|
| 131 | S TWO=$P($G(^PRST(457.1,+TOD,0)),U,5)
|
|---|
| 132 | S DY2=TWO="Y"
|
|---|
| 133 | I TOD2,'DY2 S TWO=$P($G(^PRST(457.1,+TOD2,0)),U,5),DY2=TWO="Y"
|
|---|
| 134 | ;
|
|---|
| 135 | ;loop thru 5 columns, 7 time segments
|
|---|
| 136 | ; quit if we encounter an error
|
|---|
| 137 | F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 138 | .;
|
|---|
| 139 | .; if absolutely nothing on any segments in the row or just a zero
|
|---|
| 140 | .; in meal column then skip row.
|
|---|
| 141 | .;
|
|---|
| 142 | . 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)))
|
|---|
| 143 | . Q:NOTHING
|
|---|
| 144 | .;
|
|---|
| 145 | .; missing start or stop
|
|---|
| 146 | . I $P(Z,U,K)=""!($P(Z,U,K+1)="") D E8 S DDSERROR=1 Q
|
|---|
| 147 | .;
|
|---|
| 148 | .; 2nd day posting on 1 day tour (ALLOW RG POSTING ACROSS MID)
|
|---|
| 149 | . S X=$P(Z,U,K)_U_$P(Z,U,K+1)
|
|---|
| 150 | . D CNV^PRSATIM S Z1=$P(Y,U,1),Z2=$P(Y,U,2)
|
|---|
| 151 | . D V0^PRSATP1
|
|---|
| 152 | . I Z2>1440,TWO'="Y","RG OT CT SB ON UA"'[$P(Z,U,K+2) D Q
|
|---|
| 153 | .. D E4
|
|---|
| 154 | .. S DDSERROR=1
|
|---|
| 155 | .;
|
|---|
| 156 | .; posted more than 48 hrs (2880 min)
|
|---|
| 157 | . I Z2>2880 D E5 S DDSERROR=1 Q
|
|---|
| 158 | .;
|
|---|
| 159 | .; no type of time
|
|---|
| 160 | . I $P(Z,U,K+2)="" D E9 S DDSERROR=1 Q
|
|---|
| 161 | .;
|
|---|
| 162 | . 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
|
|---|
| 163 | . 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
|
|---|
| 164 | . I $P(Z,U,K+2)'="" S T(Z1,K)=Z2_U_$P(Z,U,K,K+3)
|
|---|
| 165 | ;
|
|---|
| 166 | ; T: 1st subscript is start time (minutes from midnight)
|
|---|
| 167 | ; 2nd subsc is segment number on form (or in Z var)
|
|---|
| 168 | ; piece 1 stop time in minutes from midnight.
|
|---|
| 169 | ; for 3 segment postings will look like the following:
|
|---|
| 170 | ; T(945,1)=1140^03:45P^07:00P^RG^
|
|---|
| 171 | ; T(1140,6)=1305^07:00P^09:45P^RG^
|
|---|
| 172 | ; T(1320,11)=1380^10:00P^11:00P^RG
|
|---|
| 173 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 174 | I '$D(T) Q
|
|---|
| 175 | ;
|
|---|
| 176 | ; segment overlap
|
|---|
| 177 | I Z'["HX",'(Z["^ON"&(Z["OT")),'(Z["^ON"&(Z["CT")) D
|
|---|
| 178 | . S Z1=""
|
|---|
| 179 | . F S Z1=$O(T(Z1)) Q:Z1=""!($G(DDSERROR)) D
|
|---|
| 180 | .. I Z1'<T(Z1,$O(T(Z1,0))) D
|
|---|
| 181 | ... D E1
|
|---|
| 182 | ... S DDSERROR=1
|
|---|
| 183 | .. E D
|
|---|
| 184 | ... S Y=$O(T(Z1))
|
|---|
| 185 | ... I Y,T(Z1,$O(T(Z1,0)))>Y S DDSERROR=1 D E2
|
|---|
| 186 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 187 | ;
|
|---|
| 188 | ; leave outside time segments
|
|---|
| 189 | I $$VALIDLV^PRSPESR2(PRSN1,.T),$$VALIDLV^PRSPESR2(PRSN4,.T) S DDSERROR=1 D E14,HLP^DDSUTL(.STR) Q
|
|---|
| 190 | ;
|
|---|
| 191 | S Z1=$$GET^DDSVAL(DIE,.DA,145)
|
|---|
| 192 | ;
|
|---|
| 193 | ; make sure we have some txt in remarks field when required
|
|---|
| 194 | I Z1="" D
|
|---|
| 195 | . F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 196 | .. I $P(Z,U,K+2)="AA" D E6 S DDSERROR=1 Q
|
|---|
| 197 | .. I $P(Z,U,K+2)="WP",$P(Z,U,K+3)=3 D E10 S DDSERROR=1 Q
|
|---|
| 198 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 199 | ;
|
|---|
| 200 | ; check for too much total meal for whole day
|
|---|
| 201 | S MTOT=0
|
|---|
| 202 | F K=1:5:31 S MTOT=MTOT+$P(Z,U,K+4)
|
|---|
| 203 | I MTOT>MLALLOW D E15 S DDSERROR=1 D HLP^DDSUTL(.STR) Q
|
|---|
| 204 | ;
|
|---|
| 205 | ; check for too much meal on any segment
|
|---|
| 206 | F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 207 | . S MLP=$P(Z,U,K+4)
|
|---|
| 208 | . I MLP>0 D
|
|---|
| 209 | .. N WORK S WORK=$$ELAPSE^PRSPESR2(MLP,$P(Z,U,K),$P(Z,U,K+1))
|
|---|
| 210 | .. I $E(WORK,1,1)="-"!(WORK="00:00")!(WORK=0) D E17 S DDSERROR=1
|
|---|
| 211 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 212 | ;
|
|---|
| 213 | ; check for comptime earned and used w/out remarks
|
|---|
| 214 | F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 215 | . I ($P(Z,U,K+2)="CT")&($P(Z,U,K+3)="") D E11 S DDSERROR=1
|
|---|
| 216 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 217 | ;
|
|---|
| 218 | F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 219 | . I ($P(Z,U,K+2)="CU")&($P(Z,U,K+3)="") D E12 S DDSERROR=1
|
|---|
| 220 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 221 | ;
|
|---|
| 222 | ;make sure compressed tours don't post credit hrs remarks.
|
|---|
| 223 | I $$COMPR^PRSATP1(PPI,DFN) D
|
|---|
| 224 | . F K=1:5:31 Q:$G(DDSERROR) D
|
|---|
| 225 | .. I $$CTCH^PRSATP1(Z,K) D E13 S DDSERROR=1
|
|---|
| 226 | I $G(DDSERROR) D HLP^DDSUTL(.STR) Q
|
|---|
| 227 | Q
|
|---|
| 228 | E1 S STR="A start time is not less than a stop time." Q
|
|---|
| 229 | E2 S STR="End of one segment must not be greater than start of next." Q
|
|---|
| 230 | E3 S STR="Duplicate start times encountered." Q
|
|---|
| 231 | E4 S STR="Segment of second day encountered; no two-day tour specified." Q
|
|---|
| 232 | E5 S STR="Segment of third day encountered." Q
|
|---|
| 233 | E6 S STR="Remarks must be entered when AA is posted." Q
|
|---|
| 234 | E7 S STR="HW can only be posted with HX or on a Holiday." Q
|
|---|
| 235 | E8 S STR="Start or Stop Time not entered for a segment." Q
|
|---|
| 236 | E9 S STR="Type of Time not entered for a segment." Q
|
|---|
| 237 | E10 S STR="Remarks must be entered for WP due to AWOL." Q
|
|---|
| 238 | E11 S STR="REMARKS CODE must be entered when CT is posted." Q
|
|---|
| 239 | E12 S STR="REMARKS CODE must be entered when CU is posted." Q
|
|---|
| 240 | E13 S STR="REMARKS CODE: Compressed tours can't earn credit hours." Q
|
|---|
| 241 | E14 S STR="Leave cannot be posted outside tour." Q
|
|---|
| 242 | E15 S STR="Meal time cannot exceed "_MLALLOW_" minutes." Q
|
|---|
| 243 | 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."
|
|---|
| 244 | E17 S STR="Meal time must be less than time on the segment it is posted with." Q
|
|---|
| 245 | Q
|
|---|
