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

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBTOBI3 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**40,56**; 21-MAR-94
3 ;
4HR ; -- print hospital review information
5 Q:'$O(^IBT(356.1,"C",+IBTRN,0)) ; -no reivews
6 I ($Y+11)>IOSL D HDR^IBTOBI Q:IBQUIT
7 W !," Hospital Review Information "
8 N I,J,IBII,IBTRV,IBTRVD
9 S IBII="" F S IBII=$O(^IBT(356.1,"ATIDT",IBTRN,IBII)) Q:'IBII!(IBQUIT) S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IBII,IBTRV)) Q:'IBTRV!(IBQUIT) D
10 .N IBD
11 .D HR1
12 .D HR2
13 .; Patch #40
14 .D UNIT
15 .S IBJ=0 F S IBJ=$O(IBD(IBJ)) Q:'IBJ W !,$E($G(IBD(IBJ,1)),1,40),?40,$E($G(IBD(IBJ,2)),1,39)
16 .D COMM1(IBTRV) Q:IBQUIT
17 .W !?30,"-----------------------------------"
18 .I ($Y+11)>IOSL D HDR^IBTOBI Q:IBQUIT
19 W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
20 Q
21 ;
22HR1 ; -- print one review
23 S IBTRVD=$G(^IBT(356.1,+IBTRV,0))
24 S IBTRTP=$P($G(^IBE(356.11,+$P($G(^IBT(356.1,IBTRV,0)),"^",22),0)),"^",2)
25 D @IBTRTP
26 Q
2710 ; -- precert review
2815 ; -- admission review
2920 ; -- urgent adm. review
30 S IBD(1,2)=" Severity of Ill: "_$$SI^IBTRVD0($P(IBTRVD,"^",4))
31 S IBD(2,2)="Intensity of Svc: "_$$SI^IBTRVD0($P(IBTRVD,"^",5))
32 S IBD(3,2)=" Criteria Met: "_$$EXPAND^IBTRE(356.1,.06,$P(IBTRVD,"^",6))
33 S IBD(4,2)=" Prov. Intervwed: "_$$EXPAND^IBTRE(356.1,.1,$P(IBTRVD,"^",10))
34 S IBD(5,2)=" Dec. Influenced: "_$$EXPAND^IBTRE(356.1,.11,$P(IBTRVD,"^",11))
35 S IBD=5
36 S IBNAR=0 F S IBNAR=+$O(^IBT(356.1,+IBTRV,12,IBNAR)) Q:'IBNAR D
37 .S IBNARD=$G(^IBT(356.1,+IBTRV,12,IBNAR,0))
38 .S IBD=IBD+1
39 .S IBD(IBD,2)="Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P(^(0),"^")
40 Q
4130 ; -- concurrent review
42 S IBD(1,2)=" Day of Review: "_$J($P(IBTRVD,"^",3),2)
43 S IBD(2,2)=" Severity of Ill: "_$$SI^IBTRVD0($P(IBTRVD,"^",4))
44 S IBD(3,2)="Intensity of Svc: "_$$SI^IBTRVD0($P(IBTRVD,"^",5))
45 S IBD(4,2)="Dschg Screen Met: "_$$EXPAND^IBTRE(356.1,.12,$P(IBTRVD,"^",12))
46 S IBD(5,2)="Acute Care Dschg: "_$$EXPAND^IBTRE(356.1,1.17,$P($G(^IBT(356.1,+IBTRV,1)),"^",17))
47 S IBD=5
48 S IBNAR=0 F S IBNAR=+$O(^IBT(356.1,+IBTRV,13,IBNAR)) Q:'IBNAR D
49 .S IBNARD=$G(^IBT(356.1,+IBTRV,13,IBNAR,0))
50 .S IBD=IBD+1
51 .S IBD(IBD,2)="Non-Acute Reason: "_$P($G(^IBE(356.4,+IBNARD,0)),"^",2)_" - "_$P(^(0),"^")
52 Q
5340 ; -- discharge review
54 S IBD(1,2)="Discharge Screen: "_$$SI^IBTRVD0($P(IBTRVD,"^",12))
55 S IBD=1
56 Q
57 ;
5850 ;
5960 ;
6070 ;
6180 ;
6285 ;
6390 ;
64 S IBD=0
65 Q
66 ;
67UNIT ; -- Special unit information
68 I '$D(IBD) S IBD=0
69 I IBTRTP=40 S IBD(IBD+1,2)=" D/C Screen Met: "_$$SI^IBTRVD0($P(IBTRVD,"^",13)) Q
70 ; Patch #40
71 S IBD(IBD+1,2)=" Special Unit SI: "_$$SI^IBTRVD0($P(IBTRVD,"^",8))
72 S IBD(IBD+2,2)=" Special Unit IS: "_$$SI^IBTRVD0($P(IBTRVD,"^",9))
73 Q
74 ;
75HR2 ; -- contact information
76 S IBD(1,1)=" Review Date: "_$$DAT1^IBOUTL(+IBTRVD,"2P")
77 S IBD(2,1)=" Review Type: "_$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^",1)
78 S IBD(3,1)=" Specialty: "_$P($G(^DIC(45.7,+$P(IBTRVD,"^",7),0)),"^")
79 S IBD(4,1)=" Methodology: "_$$EXPAND^IBTRE(356.1,.23,$P(IBTRVD,"^",23))
80 S IBD(5,1)=" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21))
81 S IBD(6,1)=" Last Edited By: "_$E($$EXPAND^IBTRE(356.1,1.04,$P($G(^IBT(356.1,+$G(IBTRV),1)),"^",4)),1,20)
82 S IBD(7,1)="Next Review Date: "_$$DAT1^IBOUTL($P(IBTRVD,"^",20))
83 Q
84 ;
85COMM1(DA) ; -- print comments from ins. reviews.
86 W !,"Comment: "
87 K ^UTILITY($J,"W")
88 S DIWL=10,DIWR=IOM-12,DIWF="W"
89 S IBJ=0 F S IBJ=$O(^IBT(356.1,DA,11,IBJ)) Q:'IBJ S X=^(IBJ,0) D ^DIWP I IOSL<($Y+4) Q:IBQUIT D HDR^IBTOBI
90 Q:IBQUIT
91 D ^DIWW
92 Q
Note: See TracBrowser for help on using the repository browser.