Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTRVD0

IBTRVD0.m

Go to the documentation of this file.
  1. IBTRVD0 ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % I '$G(IBTRV) G ^IBTRV
  1. D VISIT,REVIEW,STATUS,CRITER,UNIT
  1. Q
  1. ;
  1. VISIT ; -- Visit information
  1. N OFFSET,START,VAIN,VAINDT,IBETYP
  1. S VAINDT=$$VNDT^IBTRV(IBTRV)
  1. S VA200="" D INP^VADPT
  1. S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
  1. S START=1,OFFSET=2
  1. D VISIT^IBTRED
  1. Q
  1. ;
  1. REVIEW ; -- Review Information
  1. N OFFSET,START,IBI,IBTRC,IBTRCD
  1. S START=1,OFFSET=45
  1. ; -- get related review information
  1. S (IBTRC,IBI)=0 F S IBI=$O(^IBT(356.2,"AD",IBTRV,IBI)) Q:'IBI S IBTRC=IBI
  1. S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
  1. D SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
  1. D SET^IBCNSP(START+1,OFFSET," Review Type: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",1))
  1. D SET^IBCNSP(START+2,OFFSET," Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P"))
  1. D SET^IBCNSP(START+3,OFFSET," Specialty: "_$P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"))
  1. D SET^IBCNSP(START+4,OFFSET," Methodology: "_$$EXPAND^IBTRE(356.1,.23,$P(IBTRVD,"^",23)))
  1. D SET^IBCNSP(START+5,OFFSET," Ins. Action: "_$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^"))
  1. Q
  1. ;
  1. UNIT ; -- Special unit information
  1. N OFFSET,START
  1. S START=8,OFFSET=45
  1. D SET^IBCNSP(START,OFFSET," Special Unit Information ",IORVON,IORVOFF)
  1. I IBTRTP=40 D SET^IBCNSP(START+1,OFFSET," D/C Screen Met: "_$$SI($P(IBTRVD,"^",13))) Q
  1. D SET^IBCNSP(START+1,OFFSET,"Special Unit SI: "_$$SI($P(IBTRVD,"^",8)))
  1. D SET^IBCNSP(START+2,OFFSET,"Special Unit IS: "_$$SI($P(IBTRVD,"^",9)))
  1. Q
  1. ;
  1. STATUS ; -- Status/user information
  1. N OFFSET,START
  1. S START=17,OFFSET=2
  1. D SET^IBCNSP(START,OFFSET," Status Information ",IORVON,IORVOFF)
  1. D SET^IBCNSP(START+1,OFFSET," Review Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)))
  1. D SET^IBCNSP(START+2,OFFSET," Entered by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",2),0)),"^"))
  1. D SET^IBCNSP(START+3,OFFSET," Entered on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",1),"2P"))
  1. D SET^IBCNSP(START+4,OFFSET," Completed by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",4),0)),"^"))
  1. D SET^IBCNSP(START+5,OFFSET," Completed on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",3),"2P"))
  1. I $P(IBTRVD,"^",21)<3 D SET^IBCNSP(START+6,OFFSET,"Next Review Date: "_$$DAT1^IBOUTL($P(IBTRVD,"^",20),"2P")) G STATQ
  1. STATQ Q
  1. ;
  1. CRITER ; -- Criteria information
  1. N OFFSET,START,IBD,IBNAR,IBNARD
  1. S START=8,OFFSET=2
  1. D SET^IBCNSP(START,OFFSET," Criteria Information ",IORVON,IORVOFF)
  1. I IBTRTP D @IBTRTP
  1. Q
  1. 10 ; -- precert review
  1. 15 ; -- admission review
  1. 20 ; -- urgent adm. review
  1. 50 ;
  1. 60 ;
  1. 65 ;
  1. 70 ;
  1. 80 ;
  1. 85 ;
  1. 90 ;
  1. 100 ;
  1. ;
  1. D SET^IBCNSP(START+1,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
  1. D SET^IBCNSP(START+2,OFFSET,"Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
  1. D SET^IBCNSP(START+3,OFFSET," Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$P(IBTRVD,"^",6)))
  1. D SET^IBCNSP(START+4,OFFSET," Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$P(IBTRVD,"^",10)))
  1. D SET^IBCNSP(START+5,OFFSET," Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$P(IBTRVD,"^",11)))
  1. D SET^IBCNSP(START+6,OFFSET,"Non-Acute Reason: ")
  1. S IBD=5
  1. ;
  1. S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,12,IBNAR)) Q:'IBNAR D
  1. .S IBNARD=$G(^IBT(356.1,+IBTRV,12,IBNAR,0))
  1. .S IBD=IBD+1 Q:IBD>8
  1. .D SET^IBCNSP(START+IBD,OFFSET,"Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
  1. Q
  1. ;
  1. 30 ; -- concurrent review
  1. D SET^IBCNSP(START+1,OFFSET," Day of Review: "_$J($P(IBTRVD,"^",3),2))
  1. D SET^IBCNSP(START+2,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
  1. D SET^IBCNSP(START+3,OFFSET," Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
  1. D SET^IBCNSP(START+4,OFFSET," Dschg Screen Met: "_$E($$SI($P(IBTRVD,"^",12)),1,22))
  1. D SET^IBCNSP(START+5,OFFSET," Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$P(IBTRVD1,"^",17)))
  1. D SET^IBCNSP(START+6,OFFSET," Non-Acute Reason: ")
  1. S IBD=5
  1. ;
  1. S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,13,IBNAR)) Q:'IBNAR D
  1. .S IBNARD=$G(^IBT(356.1,+IBTRV,13,IBNAR,0))
  1. .S IBD=IBD+1 Q:IBD>8
  1. .D SET^IBCNSP(START+IBD,OFFSET," Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
  1. Q
  1. 40 ; -- discharge review
  1. D SET^IBCNSP(START+1,OFFSET,"Discharge Screen: "_$$SI($P(IBTRVD,"^",12)))
  1. Q
  1. ;
  1. SI(X) ; -- output the name value of a si/is
  1. ; input the pointer to 356.3
  1. N Y S Y=$G(^IBE(356.3,+$G(X),0))
  1. ; Q $P($G(^IBE(356.3,+$G(X),0)),"^")
  1. Q $P(Y,"^",3)_$S(Y'="":" - ",1:"")_$P(Y,"^")