IBQLLD2 ;LEB/MRY - LOAD UMR FILE/EDIT CHECK ORDER ; 21-AUG-95
;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
ORDCHK ; -- edit check the UR procedure in entering reviews.
S IBTRV=0 K IBORDER
F S IBTRV=$O(^IBT(356.1,"C",IBTRN,IBTRV)) Q:'IBTRV D Q:IBQUIT
.; -- check for bad cross-reference in Reviews
.S IBTRVD=$G(^IBT(356.1,IBTRV,0)) I '+IBTRVD S IBQUIT=1 Q
.; -- ignore reviews that are INACTIVE
.I '$P(IBTRVD,"^",19)!'$P(IBTRVD,"^",21) Q
.; -- check for no DAY entered in Review.
.I '$P(IBTRVD,"^",3) S IBQUIT=1 Q
.; -- check for Reviews with a same DAY.
.I $D(IBORDER($P(IBTRVD,"^",3))) S IBQUIT=1 Q
.I 'IBQUIT S IBORDER($P(IBTRVD,"^",3))=IBTRV
G:IBQUIT END S IBDAY=0
; -- check for Reviews that are not in consecutive order.
F IBCNT=1:1 S IBDAY=$O(IBORDER(IBDAY)) Q:'IBDAY D Q:IBQUIT
.I IBDAY'=IBCNT S IBQUIT=1
;
END ; -- clean up
Q:$D(IBQLR3)
I $O(^TMP("IBQLPL",$J,IB(.03),IBDDT,0)) S ^TMP("IBQLPL",$J,IB(.03),IBDDT)=IBNAM
K IBDAY,IBCNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBQLLD2 1070 printed Dec 13, 2024@02:41:17 Page 2
IBQLLD2 ;LEB/MRY - LOAD UMR FILE/EDIT CHECK ORDER ; 21-AUG-95
+1 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;;Oct 01, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
ORDCHK ; -- edit check the UR procedure in entering reviews.
+1 SET IBTRV=0
KILL IBORDER
+2 FOR
SET IBTRV=$ORDER(^IBT(356.1,"C",IBTRN,IBTRV))
if 'IBTRV
QUIT
Begin DoDot:1
+3 ; -- check for bad cross-reference in Reviews
+4 SET IBTRVD=$GET(^IBT(356.1,IBTRV,0))
IF '+IBTRVD
SET IBQUIT=1
QUIT
+5 ; -- ignore reviews that are INACTIVE
+6 IF '$PIECE(IBTRVD,"^",19)!'$PIECE(IBTRVD,"^",21)
QUIT
+7 ; -- check for no DAY entered in Review.
+8 IF '$PIECE(IBTRVD,"^",3)
SET IBQUIT=1
QUIT
+9 ; -- check for Reviews with a same DAY.
+10 IF $DATA(IBORDER($PIECE(IBTRVD,"^",3)))
SET IBQUIT=1
QUIT
+11 IF 'IBQUIT
SET IBORDER($PIECE(IBTRVD,"^",3))=IBTRV
End DoDot:1
if IBQUIT
QUIT
+12 if IBQUIT
GOTO END
SET IBDAY=0
+13 ; -- check for Reviews that are not in consecutive order.
+14 FOR IBCNT=1:1
SET IBDAY=$ORDER(IBORDER(IBDAY))
if 'IBDAY
QUIT
Begin DoDot:1
+15 IF IBDAY'=IBCNT
SET IBQUIT=1
End DoDot:1
if IBQUIT
QUIT
+16 ;
END ; -- clean up
+1 if $DATA(IBQLR3)
QUIT
+2 IF $ORDER(^TMP("IBQLPL",$JOB,IB(.03),IBDDT,0))
SET ^TMP("IBQLPL",$JOB,IB(.03),IBDDT)=IBNAM
+3 KILL IBDAY,IBCNT
+4 QUIT
