source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDVAL.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1ORWDVAL ; SLC/KCM - Validate procedures
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4VALSCHED(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
15STOPDT(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
20EXPSCHED(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
38DATE ; Validate a date/time (allow visits)
39 Q
Note: See TracBrowser for help on using the repository browser.