IBTRVD0 ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993
;;2.0;INTEGRATED BILLING;**58,458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% I '$G(IBTRV) G ^IBTRV
D VISIT,REVIEW,STATUS,CRITER
Q
;
VISIT ; -- Visit information
N OFFSET,START,VAIN,VAINDT,IBETYP
S VAINDT=$$VNDT^IBTRV(IBTRV)
S VA200="" D INP^VADPT
S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
S START=1,OFFSET=2
D VISIT^IBTRED
Q
;
REVIEW ; -- Review Information
N OFFSET,START,IBI,IBTRC,IBTRCD
S START=1,OFFSET=45
; -- get related review information
S (IBTRC,IBI)=0 F S IBI=$O(^IBT(356.2,"AD",IBTRV,IBI)) Q:'IBI S IBTRC=IBI
S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
D SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Review Type: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",1))
D SET^IBCNSP(START+2,OFFSET," Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P"))
D SET^IBCNSP(START+3,OFFSET," Specialty: "_$P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"))
D SET^IBCNSP(START+4,OFFSET," Methodology: "_$$EXPAND^IBTRE(356.1,.23,$P(IBTRVD,"^",23)))
D SET^IBCNSP(START+5,OFFSET," Ins. Action: "_$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^"))
Q
;
UNIT ; -- Special unit information
; for patch 58 and the 1995 interqual criteria, this entry to display
; the special unit information is no longer used
N OFFSET,START
S START=8,OFFSET=45
D SET^IBCNSP(START,OFFSET," Special Unit Information ",IORVON,IORVOFF)
I IBTRTP=40 D SET^IBCNSP(START+1,OFFSET," D/C Screen Met: "_$$SI($P(IBTRVD,"^",13))) Q
D SET^IBCNSP(START+1,OFFSET,"Special Unit SI: "_$$SI($P(IBTRVD,"^",8)))
D SET^IBCNSP(START+2,OFFSET,"Special Unit IS: "_$$SI($P(IBTRVD,"^",9)))
Q
;
STATUS ; -- Status/user information
N OFFSET,START
S START=17,OFFSET=2
D SET^IBCNSP(START,OFFSET," Status Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Review Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)))
D SET^IBCNSP(START+2,OFFSET," Entered by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",2),0)),"^"))
D SET^IBCNSP(START+3,OFFSET," Entered on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",1),"2P"))
D SET^IBCNSP(START+4,OFFSET," Completed by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",4),0)),"^"))
D SET^IBCNSP(START+5,OFFSET," Completed on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",3),"2P"))
I $P(IBTRVD,"^",21)<3 D SET^IBCNSP(START+6,OFFSET,"Next Review Date: "_$$DAT1^IBOUTL($P(IBTRVD,"^",20),"2P")) G STATQ
STATQ Q
;
CRITER ; -- Criteria information
N OFFSET,START,IBD,IBNAR,IBNARD
S START=8,OFFSET=2
D SET^IBCNSP(START,OFFSET," Criteria Information ",IORVON,IORVOFF)
I IBTRTP D @IBTRTP
Q
10 ; -- precert review
15 ; -- admission review
20 ; -- urgent adm. review
25 ;
35 ;
50 ;
55 ;
60 ;
65 ;
70 ;
80 ;
85 ;
90 ;
100 ;
;
D SET^IBCNSP(START+1,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
D SET^IBCNSP(START+2,OFFSET,"Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
D SET^IBCNSP(START+3,OFFSET," Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$P(IBTRVD,"^",6)))
D SET^IBCNSP(START+4,OFFSET," Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$P(IBTRVD,"^",10)))
D SET^IBCNSP(START+5,OFFSET," Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$P(IBTRVD,"^",11)))
D SET^IBCNSP(START+6,OFFSET,"Non-Acute Reason: ")
S IBD=5
;
S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,12,IBNAR)) Q:'IBNAR D
.S IBNARD=$G(^IBT(356.1,+IBTRV,12,IBNAR,0))
.S IBD=IBD+1 Q:IBD>8
.D SET^IBCNSP(START+IBD,OFFSET,"Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
Q
;
30 ; -- concurrent review
D SET^IBCNSP(START+1,OFFSET," Day of Review: "_$J($P(IBTRVD,"^",3),2))
D SET^IBCNSP(START+2,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
D SET^IBCNSP(START+3,OFFSET," Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
D SET^IBCNSP(START+4,OFFSET," Dschg Screen Met: "_$E($$SI($P(IBTRVD,"^",12)),1,22))
D SET^IBCNSP(START+5,OFFSET," Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$P(IBTRVD1,"^",17)))
D SET^IBCNSP(START+6,OFFSET," Non-Acute Reason: ")
S IBD=5
;
S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,13,IBNAR)) Q:'IBNAR D
.S IBNARD=$G(^IBT(356.1,+IBTRV,13,IBNAR,0))
.S IBD=IBD+1 Q:IBD>8
.D SET^IBCNSP(START+IBD,OFFSET," Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
Q
40 ; -- discharge review
D SET^IBCNSP(START+1,OFFSET,"Discharge Screen: "_$$SI($P(IBTRVD,"^",12)))
Q
;
SI(X) ; -- output the name value of a si/is
; input the pointer to 356.3
N Y S Y=$G(^IBE(356.3,+$G(X),0))
; Q $P($G(^IBE(356.3,+$G(X),0)),"^")
Q $P(Y,"^",3)_$S(Y'="":" - ",1:"")_$P(Y,"^")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRVD0 4721 printed Apr 09, 2024@21:33:37 Page 2
IBTRVD0 ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**58,458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% IF '$GET(IBTRV)
GOTO ^IBTRV
+1 DO VISIT
DO REVIEW
DO STATUS
DO CRITER
+2 QUIT
+3 ;
VISIT ; -- Visit information
+1 NEW OFFSET,START,VAIN,VAINDT,IBETYP
+2 SET VAINDT=$$VNDT^IBTRV(IBTRV)
+3 SET VA200=""
DO INP^VADPT
+4 SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
+5 SET START=1
SET OFFSET=2
+6 DO VISIT^IBTRED
+7 QUIT
+8 ;
REVIEW ; -- Review Information
+1 NEW OFFSET,START,IBI,IBTRC,IBTRCD
+2 SET START=1
SET OFFSET=45
+3 ; -- get related review information
+4 SET (IBTRC,IBI)=0
FOR
SET IBI=$ORDER(^IBT(356.2,"AD",IBTRV,IBI))
if 'IBI
QUIT
SET IBTRC=IBI
+5 SET IBTRCD=$GET(^IBT(356.2,+IBTRC,0))
+6 DO SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
+7 DO SET^IBCNSP(START+1,OFFSET," Review Type: "_$PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^",1))
+8 DO SET^IBCNSP(START+2,OFFSET," Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P"))
+9 DO SET^IBCNSP(START+3,OFFSET," Specialty: "_$PIECE($GET(^DIC(45.7,+$PIECE(IBTRVD,"^",7),0)),"^"))
+10 DO SET^IBCNSP(START+4,OFFSET," Methodology: "_$$EXPAND^IBTRE(356.1,.23,$PIECE(IBTRVD,"^",23)))
+11 DO SET^IBCNSP(START+5,OFFSET," Ins. Action: "_$PIECE($GET(^IBE(356.7,+$PIECE(IBTRCD,"^",11),0)),"^"))
+12 QUIT
+13 ;
UNIT ; -- Special unit information
+1 ; for patch 58 and the 1995 interqual criteria, this entry to display
+2 ; the special unit information is no longer used
+3 NEW OFFSET,START
+4 SET START=8
SET OFFSET=45
+5 DO SET^IBCNSP(START,OFFSET," Special Unit Information ",IORVON,IORVOFF)
+6 IF IBTRTP=40
DO SET^IBCNSP(START+1,OFFSET," D/C Screen Met: "_$$SI($PIECE(IBTRVD,"^",13)))
QUIT
+7 DO SET^IBCNSP(START+1,OFFSET,"Special Unit SI: "_$$SI($PIECE(IBTRVD,"^",8)))
+8 DO SET^IBCNSP(START+2,OFFSET,"Special Unit IS: "_$$SI($PIECE(IBTRVD,"^",9)))
+9 QUIT
+10 ;
STATUS ; -- Status/user information
+1 NEW OFFSET,START
+2 SET START=17
SET OFFSET=2
+3 DO SET^IBCNSP(START,OFFSET," Status Information ",IORVON,IORVOFF)
+4 DO SET^IBCNSP(START+1,OFFSET," Review Status: "_$$EXPAND^IBTRE(356.1,.21,$PIECE(IBTRVD,"^",21)))
+5 DO SET^IBCNSP(START+2,OFFSET," Entered by: "_$PIECE($GET(^VA(200,+$PIECE(IBTRVD1,"^",2),0)),"^"))
+6 DO SET^IBCNSP(START+3,OFFSET," Entered on: "_$$DAT1^IBOUTL($PIECE(IBTRVD1,"^",1),"2P"))
+7 DO SET^IBCNSP(START+4,OFFSET," Completed by: "_$PIECE($GET(^VA(200,+$PIECE(IBTRVD1,"^",4),0)),"^"))
+8 DO SET^IBCNSP(START+5,OFFSET," Completed on: "_$$DAT1^IBOUTL($PIECE(IBTRVD1,"^",3),"2P"))
+9 IF $PIECE(IBTRVD,"^",21)<3
DO SET^IBCNSP(START+6,OFFSET,"Next Review Date: "_$$DAT1^IBOUTL($PIECE(IBTRVD,"^",20),"2P"))
GOTO STATQ
STATQ QUIT
+1 ;
CRITER ; -- Criteria information
+1 NEW OFFSET,START,IBD,IBNAR,IBNARD
+2 SET START=8
SET OFFSET=2
+3 DO SET^IBCNSP(START,OFFSET," Criteria Information ",IORVON,IORVOFF)
+4 IF IBTRTP
DO @IBTRTP
+5 QUIT
10 ; -- precert review
15 ; -- admission review
20 ; -- urgent adm. review
25 ;
35 ;
50 ;
55 ;
60 ;
65 ;
70 ;
80 ;
85 ;
90 ;
100 ;
+1 ;
+2 DO SET^IBCNSP(START+1,OFFSET," Severity of Ill: "_$EXTRACT($$SI($PIECE(IBTRVD,"^",4)),1,22))
+3 DO SET^IBCNSP(START+2,OFFSET,"Intensity of Svc: "_$EXTRACT($$SI($PIECE(IBTRVD,"^",5)),1,22))
+4 DO SET^IBCNSP(START+3,OFFSET," Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$PIECE(IBTRVD,"^",6)))
+5 DO SET^IBCNSP(START+4,OFFSET," Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$PIECE(IBTRVD,"^",10)))
+6 DO SET^IBCNSP(START+5,OFFSET," Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$PIECE(IBTRVD,"^",11)))
+7 DO SET^IBCNSP(START+6,OFFSET,"Non-Acute Reason: ")
+8 SET IBD=5
+9 ;
+10 SET IBNAR=0
FOR
SET IBNAR=$ORDER(^IBT(356.1,+IBTRV,12,IBNAR))
if 'IBNAR
QUIT
Begin DoDot:1
+11 SET IBNARD=$GET(^IBT(356.1,+IBTRV,12,IBNAR,0))
+12 SET IBD=IBD+1
if IBD>8
QUIT
+13 DO SET^IBCNSP(START+IBD,OFFSET,"Non-Acute Reason: "_$PIECE($GET(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$PIECE($GET(^(0)),"^"))
End DoDot:1
+14 QUIT
+15 ;
30 ; -- concurrent review
+1 DO SET^IBCNSP(START+1,OFFSET," Day of Review: "_$JUSTIFY($PIECE(IBTRVD,"^",3),2))
+2 DO SET^IBCNSP(START+2,OFFSET," Severity of Ill: "_$EXTRACT($$SI($PIECE(IBTRVD,"^",4)),1,22))
+3 DO SET^IBCNSP(START+3,OFFSET," Intensity of Svc: "_$EXTRACT($$SI($PIECE(IBTRVD,"^",5)),1,22))
+4 DO SET^IBCNSP(START+4,OFFSET," Dschg Screen Met: "_$EXTRACT($$SI($PIECE(IBTRVD,"^",12)),1,22))
+5 DO SET^IBCNSP(START+5,OFFSET," Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$PIECE(IBTRVD1,"^",17)))
+6 DO SET^IBCNSP(START+6,OFFSET," Non-Acute Reason: ")
+7 SET IBD=5
+8 ;
+9 SET IBNAR=0
FOR
SET IBNAR=$ORDER(^IBT(356.1,+IBTRV,13,IBNAR))
if 'IBNAR
QUIT
Begin DoDot:1
+10 SET IBNARD=$GET(^IBT(356.1,+IBTRV,13,IBNAR,0))
+11 SET IBD=IBD+1
if IBD>8
QUIT
+12 DO SET^IBCNSP(START+IBD,OFFSET," Non-Acute Reason: "_$PIECE($GET(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$PIECE($GET(^(0)),"^"))
End DoDot:1
+13 QUIT
40 ; -- discharge review
+1 DO SET^IBCNSP(START+1,OFFSET,"Discharge Screen: "_$$SI($PIECE(IBTRVD,"^",12)))
+2 QUIT
+3 ;
SI(X) ; -- output the name value of a si/is
+1 ; input the pointer to 356.3
+2 NEW Y
SET Y=$GET(^IBE(356.3,+$GET(X),0))
+3 ; Q $P($G(^IBE(356.3,+$G(X),0)),"^")
+4 QUIT $PIECE(Y,"^",3)_$SELECT(Y'="":" - ",1:"")_$PIECE(Y,"^")
