| 1 | ORWDVAL ; SLC/KCM - Validate procedures
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
|
---|
| 3 | ;
|
---|
| 4 | VALSCHED(ERR,SCHED) ; Validate a schedule
|
---|
| 5 | ; Set up 'interval^repeat count', if no interval assume QD
|
---|
| 6 | S ERR=0
|
---|
| 7 | S INTERVAL=$P(SCHED," ",1),REPEAT=$P(SCHED," ",2)
|
---|
| 8 | ;I '$O(^PS(51.1,"APLR",INTERVAL,0)) S ERR=1 Q
|
---|
| 9 | K ^TMP($J,"ORLIST")
|
---|
| 10 | D ZERO^PSS51P1(,INTERVAL,"LR",,"ORLIST")
|
---|
| 11 | I '$D(^TMP($J,"ORLIST","B",INTERVAL)) K ^TMP($J,"ORLIST") S ERR=1 Q
|
---|
| 12 | K ^TMP($J,"ORLIST")
|
---|
| 13 | I '(X?1"X"1.N) S ERR=1 Q
|
---|
| 14 | Q
|
---|
| 15 | STOPDT(ADATE,SCHED) ; Return stop date given a schedule
|
---|
| 16 | ; Look at max days continuous orders
|
---|
| 17 | ; set numdays to lesser of Xnn and LR MAX...
|
---|
| 18 | ; calculate stop date from collection time
|
---|
| 19 | Q
|
---|
| 20 | EXPSCHED(LST,SCHED,START,STOP,MAX) ; procedure
|
---|
| 21 | ; Expand schedule into start/stop times
|
---|
| 22 | N IEN,TYP,INTERVAL,REPEAT
|
---|
| 23 | D VALSCHED I ERR S LST=""
|
---|
| 24 | S INTERVAL=$P(SCHED," ",1),REPEAT=$E($P(SCHED," ",2),2,999)
|
---|
| 25 | K ^TMP($J,"ORWDVAL") D AP^PSS51P1("LR",INTERVAL,,,"ORWDVAL")
|
---|
| 26 | S IEN=$O(^TMP($J,"ORWDVAL","APLR",INTERVAL,0))
|
---|
| 27 | S TYP=$P($G(^TMP($J,"ORWDVAL",IEN,5)),U)
|
---|
| 28 | S FREQ=$G(^TMP($J,"ORWDVAL",IEN,2))
|
---|
| 29 | I TYP="C" D ; add interval until repeat count or stop time reached
|
---|
| 30 | . ;
|
---|
| 31 | I TYP="D" D ; from start time look for matching day of week & add
|
---|
| 32 | . ;
|
---|
| 33 | I TYP="O" D ; quit with just the start time
|
---|
| 34 | . ;
|
---|
| 35 | ; range, shift, dow-range ???
|
---|
| 36 | K ^TMP($J,"ORWDVAL")
|
---|
| 37 | Q
|
---|
| 38 | DATE ; Validate a date/time (allow visits)
|
---|
| 39 | Q
|
---|