ORWDVAL.m

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

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