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

PRSPESR2.m

Go to the documentation of this file. 
PRSPESR2 ;WOIFO/JAH - PTP ESR Edit-Calls from ScreenMan Form ;07/28/05

 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 Q

ELAPSE(MEAL,START,STOP) ; CALCULATE THE HOURS BETWEEN 2 TIMES

 ;this function is called from ScreenMan Form Computed fields

 ;  file 458 PRSA ESR EDIT form.

 N ELAPSE

 S ELAPSE=0

 Q:($G(START)="")!($G(STOP)="") ELAPSE

 S START=$$TWENTY4(START)

 ;

 S STOP=$$TWENTY4(STOP)

 ; if stop time is next day add a day

 I STOP<START!(STOP=START) D

 .  S STOP=$$FMADD^XLFDT(DT,1,0,0,0)_"."_STOP

 E  D

 .  S STOP=DT_"."_STOP

 S START=DT_"."_START

 S ELAPSE=$$FMDIFF^XLFDT(STOP,START,3)

 ;for special case of a 24 hour segment

 I ELAPSE="1" S ELAPSE="24:00"

 ;

 ;Remove any blanks

 S ELAPSE=$TR(ELAPSE," ","")

 I $G(MEAL)>0 S ELAPSE=$$MEALESS(ELAPSE,MEAL)

 S ELAPSE=$$FIVE(ELAPSE)

 Q ELAPSE

FIVE(TIME) ;ENSURE ELAPSE IS A FIVE CHAR STRING--04:15 OR 02:00

 N FIVE,HH,MM

 I $E(TIME,1,1)="-" Q "-00:00"

 S HH="00"_$P(TIME,":"),MM="00"_$P(TIME,":",2)

 S HH=$E(HH,$L(HH)-1,$L(HH))

 S MM=$E(MM,$L(MM)-1,$L(MM))

 S MM=$P(TIME,":",2)_"0"

 S MM=$E(MM,1,2)

 S FIVE=HH_":"_MM

 Q FIVE

TWENTY4(TIME) ;CONVERT TIME TO TWENTY FOUR HOUR TIME

 ;

 ; TIME Y: 0=Mid=0,1=Mid=2400 Output: Y=time in 2400

 S Y=0

 I TIME="MID"!(TIME="NOON") D

 .   S Y=$S(TIME="NOON":1200,TIME="MID":2400,1:0)

 E  D

 .  S Y=$P(TIME,":",1)_$P(TIME,":",2),Y=+Y

 I TIME["P" D

 .  S:Y<1200 Y=Y+1200

 ;

 ; pad time with leading zeros so we always have 4 digits

 ; for cases like start times of 15 past midnight 0015

 ;

 S Y="000"_Y

 S Y=$E(Y,$L(Y)-3,$L(Y))

 Q Y

MEALESS(HHMM,MEAL) ;Remove meal time from hours total

 ; (subtract a 15 minute increment from length of time

 ; in hh:mm format, i.e. hh:mm - mm

 ;

 N X,Y,DECR,OBJ,I

 S MM=$P(HHMM,":",2) ; get minutes

 ; quit minutes or meal not quarter hours

 Q:(MM#15'=0&(+MM)!((MEAL#15)'=0&(+MEAL))) HHMM

 ; get hours

 S HH=$P(HHMM,":")

 ;

 ; convert segment minutes and meal to a digit.

 ;

 S X=MM D MEALIN S OBJ=X

 S X=$G(MEAL) D MEALIN S DECR=X

 I OBJ=0 S OBJ=4

 F I=1:1:DECR D

 . I OBJ=4 S HH="0"_(+HH-1) S HH=$E(HH,$L(HH)-1,$L(HH))

 . S OBJ=$S(OBJ=4:3,OBJ=3:2,OBJ=2:1,OBJ=1:4)

 S MM=$S(OBJ=1:15,OBJ=2:30,OBJ=3:45,1:"00")

 Q $$FIVE(HH_":"_MM)

 ;

MEALIN ;convert 15 minute meal to a digit

 I +X#15=0 S X=X\15 Q

 I "^0^00^15^30^45^60^75^90^105^120^"[("^"_$G(X)_"^") D

 .  S X=$S(+X=0:0,X=60:4,X=30:2,X=15:1,X=45:3,1:0)

 E  D

 . K X

 Q

MEALOUT ; convert meal digit to minutes

 S Y=$S(Y=1:15,Y=2:30,Y=3:45,Y=4:60,1:"00")

 Q

 ;

VALIDTT ; Set DDSERROR if not a valid type of time.

 ;This procedure is called from ScreenMan form PRSA ESR EDIT (file 458)

 ;with the validate field of the Type Of Time.

 ; set DDSERROR to reject user input, then ring bell and 

 ; display a message reject explanation

 Q:X=""!($G(PPI)'>0)!($G(PRSIEN)'>0)!($G(PRSD)'>0)

 I "^RG^AL^AA^DL^ML^RL^CP^SL^HX^CB^AD^WP^TR^TV^"'[(U_X_U) D

 . S DDSERROR=1

 . D HLP^DDSUTL("Invalid type of time.")

 I "^HX^"[(U_X_U) D

 . I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",12)'>0 S DDSERROR=1 D HLP^DDSUTL("Holiday Excused is only allowed on a Holiday Benefit Day.  See Payroll to set this day as a holiday.")

 I $G(PPI),$G(PRSD),$P(^PRST(458,PPI,1),U,PRSD)>$G(DT) D

 . I "^AL^AA^DL^ML^RL^CP^SL^HX^CB^AD^WP^TR^TV^"'[(U_X_U) D

 ..   S DDSERROR=1

 ..   D HLP^DDSUTL("Invalid type of time. Only leave may be entered on future days")

 Q

VALIDLV(SSCH,SPST) ; Set DDSERROR if any posting is outside the

 ; tour time segements inappropriately

 ;

 ;INPUT:

 ;  SSCH : tour segments as scheduled from node 1 of the day multiple

 ;  SPST : tour segments as posted by ptp in T array format

 N OK,P1,P2,S1,S2,LV,I,I2,J,MSA,VALIDLV

 S (LV,OK,I)=0

 S VALIDLV=""

 ; put tour in similar format as posting

 D MARRAY(.MSA,SSCH)

 F  S I=$O(SPST(I)) Q:I'>0!(LV&'OK)  D

 .  S P1=I,I2=$O(SPST(I,0)),P2=$P(SPST(I,I2),U)

 .  Q:"^AL^AA^DL^CU^ML^RL^HX^SL^CB^AD^WP^TV^TR^"'[$P(SPST(I,I2),U,4)

 .  S LV=1,OK=0

 .  S J=0

 .  F  S J=$O(MSA(J)) Q:J'>0!OK  D

 ..    S S1=J,S2=$O(MSA(J,0)),S2=$P(MSA(J,S2),U)

 ..    I P1=S1!(P1>S1)&((P2=S2)!(P2<S2)) S OK=1

 ;

 I LV,('OK) S VALIDLV=1

 Q VALIDLV

 ;

MARRAY(MARRAY,SEGS) ; BUILD MINUTE ARRAY

 ; INPUT : SEGS--tour of duty segments in global format

 ; OUTPUT: MARRAY--array by reference of tour segments in minutes 

 ;          from midnight format

 ;          EXAMPLE:  

 ;   2 segment tour will look like the following:

 ;        MARRAY(945,1)=1140^03:45P^07:00P

 ;        MARRAY(1140,6)=1305^07:00P^09:45P

 ;        MARRAY(1320,11)=1380^10:00P^11:00P

 ;loop thru the 5 columns of the 7 time segments on ESR

 ; quit if we encounter an error

 ;

 N I,ANY,Z1,Z2,X,Y

 S ANY=1

 F I=1:3:21 Q:('ANY)  D

 . ;

 . ;if absolutely nothing on the segment then we're done

 .  S ANY=$L($P(SEGS,U,I)_$P(SEGS,U,I+1)_$P(SEGS,U,I+2))

 .  Q:'ANY

 .  S X=$P(SEGS,U,I)_U_$P(SEGS,U,I+1)

 .  D CNV^PRSATIM S Z1=$P(Y,U,1),Z2=$P(Y,U,2)

 .  D V0^PRSATP1

 .  S MARRAY(Z1,I)=Z2_U_$P(SEGS,U,I,I+2)

 Q

PSTML(ROW) ; AUTO POST MEAL TIME

 ; if the time segment row that we are on in a form covers

 ; the tour then post a meal.

 ; ROW - is passed as the 

 ; Z is in the form of NODE 5 in the 458.02 day mult

 ;  it changes with edits on the form

 ;  like Z=09:00A^NOON^RG^^30^NOON^08:00P^RG^^^08:00P^MID^CU^15

 ;

 N RNG,ST2SP,FLDNUM,BASE

 Q:$G(PRSML)=""!($G(PRSML)=0)

 ;

 S BASE=ROW-1*5

 ; quit if something is already in mealtime on the form

 Q:$P(Z,U,BASE+5)'=""

 ; compute the field number of the meal time for this row

 S FLDNUM=BASE+114

 ; get the start TO stop segments for this row of the form

 ; if it's an exact match then auto post the meal

 S ST2SP=$P(Z,U,BASE+1,BASE+2)

 I ST2SP=$P($G(PRSN1),U,1,2) D  Q

 .  D PUT^DDSVAL(DIE,.DA,FLDNUM,PRSML)

 .  D REFRESH^DDSUTL

 ; get the start TO stop segments for this row of the form

 ; if it covers the meal and then some autopost the meal

 N DY2,TWO,SCHED,POST,SCH,P1,P2,S1,S2

 ; TOD is a global set up in form start up in ESRFRM^PRSPESR1

 S ST2SP=$P(Z,U,BASE+1,BASE+3)

 S SCHED=$P($G(PRSN1),U,1,3)

 ; is this a two day tour? need to check before calling the

 ; code to set up the minutes array in MARRAY

 S TWO=$P($G(^PRST(457.1,+TOD,0)),U,5)

 S DY2=TWO="Y"

 D MARRAY(.POST,ST2SP)

 D MARRAY(.SCH,$P($G(PRSN1),U,1,3))

 ;get start and stop time minutes form midnight for both

 ; schedule and posting to determine if meal should be autoposted

 S P1=$O(POST(0))

 Q:P1'>0

 S P2=$P(POST(P1,1),U)

 Q:P2'>0

 S S1=$O(SCH(0))

 Q:S1'>0

 S S2=$P(SCH(S1,1),U)

 Q:22'>0

 I P1'>S1&(P2'<S2) D

 .  D PUT^DDSVAL(DIE,.DA,FLDNUM,PRSML)

 .  D REFRESH^DDSUTL

 .  S $P(Z,U,BASE+5)=PRSML

 Q

 ;

OVEREAT(ROW) ; Display warning on POST ACTION ON CHANGE for the 

 ; meal field on the form if lunch more than allotted for tour

 N MTOT,K,BASE,WORK,STR,PRSZ

 ; When X is null they are trying to delete and that's always ok

 Q:$G(Z)=""!($G(ROW)'>0)!($G(X)="")

 S BASE=ROW-1*5

 ;

 S WORK=$$ELAPSE^PRSPESR2(X,$P(Z,U,BASE+1),$P(Z,U,BASE+2))

 I $E(WORK,1,1)="-"!(WORK="00:00")!(WORK=0) D  Q

 .  S DDSERROR=1

 .  S STR="Meal time greater than or equal to time segment."

 .  I X=0 S STR=STR_"  Type @ to remove meal time."

 .  D HLP^DDSUTL(STR)

 S MTOT=0

 S PRSZ=Z S $P(PRSZ,U,BASE+5)=X

 F K=1:5:31 S MTOT=MTOT+$P(PRSZ,U,K+4)

 I MTOT>($G(PRSML)+$G(PRSML2)) D 

 .  S STR="Warning: More meal time than allotted with tour."

 .  D HLP^DDSUTL(.STR)

 Q

BURP(PRSN5) ; return ESR WORK NODE with no blank pieces

 ; PRSN5--esr work node $G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,5)

 ; if there's only a meal with a zero then skip that too.

 ;^^^^^NOON^08:00P^RG^^^08:00P^MID^CU^15

 ;

 N SN,I,TSEG

 S SN=""

 F I=1:5:31 D

 .  S TSEG=$P(PRSN5,U,I,I+4)

 .;  W !,I,": ",TSEG

 .  Q:TSEG="^^^^"!(TSEG="")!(TSEG="^^^^0")

 .  S SN=SN_TSEG_"^"

 Q SN