- 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 Feb 19, 2025@00:07:32 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
