ORWDVAL ; SLC/KCM - Validate procedures
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
VALSCHED(ERR,SCHED) ; Validate a schedule
; Set up 'interval^repeat count', if no interval assume QD
S ERR=0
S INTERVAL=$P(SCHED," ",1),REPEAT=$P(SCHED," ",2)
;I '$O(^PS(51.1,"APLR",INTERVAL,0)) S ERR=1 Q
K ^TMP($J,"ORLIST")
D ZERO^PSS51P1(,INTERVAL,"LR",,"ORLIST")
I '$D(^TMP($J,"ORLIST","B",INTERVAL)) K ^TMP($J,"ORLIST") S ERR=1 Q
K ^TMP($J,"ORLIST")
I '(X?1"X"1.N) S ERR=1 Q
Q
STOPDT(ADATE,SCHED) ; Return stop date given a schedule
; Look at max days continuous orders
; set numdays to lesser of Xnn and LR MAX...
; calculate stop date from collection time
Q
EXPSCHED(LST,SCHED,START,STOP,MAX) ; procedure
; Expand schedule into start/stop times
N IEN,TYP,INTERVAL,REPEAT
D VALSCHED I ERR S LST=""
S INTERVAL=$P(SCHED," ",1),REPEAT=$E($P(SCHED," ",2),2,999)
K ^TMP($J,"ORWDVAL") D AP^PSS51P1("LR",INTERVAL,,,"ORWDVAL")
S IEN=$O(^TMP($J,"ORWDVAL","APLR",INTERVAL,0))
S TYP=$P($G(^TMP($J,"ORWDVAL",IEN,5)),U)
S FREQ=$G(^TMP($J,"ORWDVAL",IEN,2))
I TYP="C" D ; add interval until repeat count or stop time reached
. ;
I TYP="D" D ; from start time look for matching day of week & add
. ;
I TYP="O" D ; quit with just the start time
. ;
; range, shift, dow-range ???
K ^TMP($J,"ORWDVAL")
Q
DATE ; Validate a date/time (allow visits)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDVAL 1420 printed Dec 13, 2024@02:35:50 Page 2
ORWDVAL ; SLC/KCM - Validate procedures
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
VALSCHED(ERR,SCHED) ; Validate a schedule
+1 ; Set up 'interval^repeat count', if no interval assume QD
+2 SET ERR=0
+3 SET INTERVAL=$PIECE(SCHED," ",1)
SET REPEAT=$PIECE(SCHED," ",2)
+4 ;I '$O(^PS(51.1,"APLR",INTERVAL,0)) S ERR=1 Q
+5 KILL ^TMP($JOB,"ORLIST")
+6 DO ZERO^PSS51P1(,INTERVAL,"LR",,"ORLIST")
+7 IF '$DATA(^TMP($JOB,"ORLIST","B",INTERVAL))
KILL ^TMP($JOB,"ORLIST")
SET ERR=1
QUIT
+8 KILL ^TMP($JOB,"ORLIST")
+9 IF '(X?1"X"1.N)
SET ERR=1
QUIT
+10 QUIT
STOPDT(ADATE,SCHED) ; Return stop date given a schedule
+1 ; Look at max days continuous orders
+2 ; set numdays to lesser of Xnn and LR MAX...
+3 ; calculate stop date from collection time
+4 QUIT
EXPSCHED(LST,SCHED,START,STOP,MAX) ; procedure
+1 ; Expand schedule into start/stop times
+2 NEW IEN,TYP,INTERVAL,REPEAT
+3 DO VALSCHED
IF ERR
SET LST=""
+4 SET INTERVAL=$PIECE(SCHED," ",1)
SET REPEAT=$EXTRACT($PIECE(SCHED," ",2),2,999)
+5 KILL ^TMP($JOB,"ORWDVAL")
DO AP^PSS51P1("LR",INTERVAL,,,"ORWDVAL")
+6 SET IEN=$ORDER(^TMP($JOB,"ORWDVAL","APLR",INTERVAL,0))
+7 SET TYP=$PIECE($GET(^TMP($JOB,"ORWDVAL",IEN,5)),U)
+8 SET FREQ=$GET(^TMP($JOB,"ORWDVAL",IEN,2))
+9 ; add interval until repeat count or stop time reached
IF TYP="C"
Begin DoDot:1
+10 ;
End DoDot:1
+11 ; from start time look for matching day of week & add
IF TYP="D"
Begin DoDot:1
+12 ;
End DoDot:1
+13 ; quit with just the start time
IF TYP="O"
Begin DoDot:1
+14 ;
End DoDot:1
+15 ; range, shift, dow-range ???
+16 KILL ^TMP($JOB,"ORWDVAL")
+17 QUIT
DATE ; Validate a date/time (allow visits)
+1 QUIT
