source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRVD0.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IBTRVD0 ;ALB/AAS - CLAIMS TRACKING - EXPANDED REVIEW SCREEN ; 02-JUL-1993
2 ;;Version 2.0 ; INTEGRATED BILLING ;**58**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% I '$G(IBTRV) G ^IBTRV
6 D VISIT,REVIEW,STATUS,CRITER
7 Q
8 ;
9VISIT ; -- Visit information
10 N OFFSET,START,VAIN,VAINDT,IBETYP
11 S VAINDT=$$VNDT^IBTRV(IBTRV)
12 S VA200="" D INP^VADPT
13 S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
14 S START=1,OFFSET=2
15 D VISIT^IBTRED
16 Q
17 ;
18REVIEW ; -- Review Information
19 N OFFSET,START,IBI,IBTRC,IBTRCD
20 S START=1,OFFSET=45
21 ; -- get related review information
22 S (IBTRC,IBI)=0 F S IBI=$O(^IBT(356.2,"AD",IBTRV,IBI)) Q:'IBI S IBTRC=IBI
23 S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
24 D SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
25 D SET^IBCNSP(START+1,OFFSET," Review Type: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",1))
26 D SET^IBCNSP(START+2,OFFSET," Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P"))
27 D SET^IBCNSP(START+3,OFFSET," Specialty: "_$P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^"))
28 D SET^IBCNSP(START+4,OFFSET," Methodology: "_$$EXPAND^IBTRE(356.1,.23,$P(IBTRVD,"^",23)))
29 D SET^IBCNSP(START+5,OFFSET," Ins. Action: "_$P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^"))
30 Q
31 ;
32UNIT ; -- Special unit information
33 ; for patch 58 and the 1995 interqual criteria, this entry to display
34 ; the special unit information is no longer used
35 N OFFSET,START
36 S START=8,OFFSET=45
37 D SET^IBCNSP(START,OFFSET," Special Unit Information ",IORVON,IORVOFF)
38 I IBTRTP=40 D SET^IBCNSP(START+1,OFFSET," D/C Screen Met: "_$$SI($P(IBTRVD,"^",13))) Q
39 D SET^IBCNSP(START+1,OFFSET,"Special Unit SI: "_$$SI($P(IBTRVD,"^",8)))
40 D SET^IBCNSP(START+2,OFFSET,"Special Unit IS: "_$$SI($P(IBTRVD,"^",9)))
41 Q
42 ;
43STATUS ; -- Status/user information
44 N OFFSET,START
45 S START=17,OFFSET=2
46 D SET^IBCNSP(START,OFFSET," Status Information ",IORVON,IORVOFF)
47 D SET^IBCNSP(START+1,OFFSET," Review Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)))
48 D SET^IBCNSP(START+2,OFFSET," Entered by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",2),0)),"^"))
49 D SET^IBCNSP(START+3,OFFSET," Entered on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",1),"2P"))
50 D SET^IBCNSP(START+4,OFFSET," Completed by: "_$P($G(^VA(200,+$P(IBTRVD1,"^",4),0)),"^"))
51 D SET^IBCNSP(START+5,OFFSET," Completed on: "_$$DAT1^IBOUTL($P(IBTRVD1,"^",3),"2P"))
52 I $P(IBTRVD,"^",21)<3 D SET^IBCNSP(START+6,OFFSET,"Next Review Date: "_$$DAT1^IBOUTL($P(IBTRVD,"^",20),"2P")) G STATQ
53STATQ Q
54 ;
55CRITER ; -- Criteria information
56 N OFFSET,START,IBD,IBNAR,IBNARD
57 S START=8,OFFSET=2
58 D SET^IBCNSP(START,OFFSET," Criteria Information ",IORVON,IORVOFF)
59 I IBTRTP D @IBTRTP
60 Q
6110 ; -- precert review
6215 ; -- admission review
6320 ; -- urgent adm. review
6450 ;
6560 ;
6665 ;
6770 ;
6880 ;
6985 ;
7090 ;
71100 ;
72 ;
73 D SET^IBCNSP(START+1,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
74 D SET^IBCNSP(START+2,OFFSET,"Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
75 D SET^IBCNSP(START+3,OFFSET," Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$P(IBTRVD,"^",6)))
76 D SET^IBCNSP(START+4,OFFSET," Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$P(IBTRVD,"^",10)))
77 D SET^IBCNSP(START+5,OFFSET," Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$P(IBTRVD,"^",11)))
78 D SET^IBCNSP(START+6,OFFSET,"Non-Acute Reason: ")
79 S IBD=5
80 ;
81 S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,12,IBNAR)) Q:'IBNAR D
82 .S IBNARD=$G(^IBT(356.1,+IBTRV,12,IBNAR,0))
83 .S IBD=IBD+1 Q:IBD>8
84 .D SET^IBCNSP(START+IBD,OFFSET,"Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
85 Q
86 ;
8730 ; -- concurrent review
88 D SET^IBCNSP(START+1,OFFSET," Day of Review: "_$J($P(IBTRVD,"^",3),2))
89 D SET^IBCNSP(START+2,OFFSET," Severity of Ill: "_$E($$SI($P(IBTRVD,"^",4)),1,22))
90 D SET^IBCNSP(START+3,OFFSET," Intensity of Svc: "_$E($$SI($P(IBTRVD,"^",5)),1,22))
91 D SET^IBCNSP(START+4,OFFSET," Dschg Screen Met: "_$E($$SI($P(IBTRVD,"^",12)),1,22))
92 D SET^IBCNSP(START+5,OFFSET," Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$P(IBTRVD1,"^",17)))
93 D SET^IBCNSP(START+6,OFFSET," Non-Acute Reason: ")
94 S IBD=5
95 ;
96 S IBNAR=0 F S IBNAR=$O(^IBT(356.1,+IBTRV,13,IBNAR)) Q:'IBNAR D
97 .S IBNARD=$G(^IBT(356.1,+IBTRV,13,IBNAR,0))
98 .S IBD=IBD+1 Q:IBD>8
99 .D SET^IBCNSP(START+IBD,OFFSET," Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P($G(^(0)),"^"))
100 Q
10140 ; -- discharge review
102 D SET^IBCNSP(START+1,OFFSET,"Discharge Screen: "_$$SI($P(IBTRVD,"^",12)))
103 Q
104 ;
105SI(X) ; -- output the name value of a si/is
106 ; input the pointer to 356.3
107 N Y S Y=$G(^IBE(356.3,+$G(X),0))
108 ; Q $P($G(^IBE(356.3,+$G(X),0)),"^")
109 Q $P(Y,"^",3)_$S(Y'="":" - ",1:"")_$P(Y,"^")
Note: See TracBrowser for help on using the repository browser.