source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTOAT1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1IBTOAT1 ;ALB/AAS - CLAIMS TRACKING ADMISSION SHEET PRINT ; 18-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**1**; 21-MAR-94
3 ;
4ONE ; -- print one sheet here - no close device, no form feeds
5 ; input DFN = patient file pointer
6 ; IBTRN = Tracking module entry
7 ;
8 Q:'$D(DFN)
9 I '$D(IOST) D HOME^%ZIS
10 N I,J,X,Y,VADM,VAOA,VAPA,VA,VAEC,VAIN,IBTRND,VAEL,VAINDT,VA200
11 ;
12 ; -- Make sure tracking entry exists
13 I +$G(IBTRN)<1!('$D(^IBT(356,+$G(IBTRN),0))) Q ;D ADM^IBTUTL()
14 S IBTRND=$G(^IBT(356,+$G(IBTRN),0))
15 ;
16 S TAB=4,TAB2=45
17 W $C(13),?(IOM-15/2),"ADMISSION SHEET"
18 S IBTITLE=$G(^IBE(350.9,1,5))
19 F I=1:1:3 W !,?(IOM-$L($P(IBTITLE,"^",I))/2),$P(IBTITLE,"^",I)
20 ;
21 D DEMO,LINE,ADM,LINE,EM,LINE
22 I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G END
23 D INS,LINE,^IBTOAT2
24END D KVAR^VADPT K VAEC,DIRUT
25 I $D(ZTQUEUED) S ZTREQ="@"
26 Q
27 ;
28ADM ; -- print admissions data
29 I $G(IBTRN)="" W !?TAB,"No admission Found",!!!! G ADMQ
30 ;S VA200="" D INP^VADPT
31 N VAINDT S VAINDT=$P(+$G(^DGPM(+$P($G(^IBT(356,IBTRN,0)),"^",5),0)),".")_.2359 D INP^VADPT
32 W !?TAB,"Adm. Date: ",$P(VAIN(7),"^",2)
33 W ?TAB2,"Adm. Type: ",$E($$ATYPE($P(IBTRND,"^",7)),1,19) ; urgent/emergent
34 W !?TAB," Provider: ",$P(VAIN(2),"^",2)
35 W ?TAB2,"Specialty: ",$P(VAIN(3),"^",2)
36 W !?TAB," Ward: ",$P(VAIN(4),"^",2)
37 W ?TAB2," Room/Bed: ",VAIN(5)
38 W !?TAB,"Adm. Diag: ",$$ADMDIAG^IBTRE6(IBTRN)
39 ;
40ADMQ Q
41 ;
42DEMO ; -- print pt. demographics
43 D 4^VADPT ;demographic and pt address
44 D ELIG^VADPT ;eligiblity data
45 ;
46 W !!?TAB," Patient: ",VADM(1)
47 W ?TAB2," Address: ",VAPA(1)
48 W !?TAB," Pt ID: ",VA("PID")
49 I VAPA(2)'="" W ?TAB2+11,VAPA(2)
50 W !?TAB," Dob: ",$P(VADM(3),"^",2)
51 I VAPA(3)'="" W ?TAB2+11,VAPA(3)
52 W !?TAB," SC: ",$S(+VAEL(3):"YES - "_$P(VAEL(3),"^",2)_"%",1:"NO")
53 W ?TAB2+11,VAPA(4),$S(VAPA(4)'="":", ",1:""),$P($G(^DIC(5,+VAPA(5),0)),"^",2)," ",VAPA(6)
54 W !?TAB," Sex: ",$P(VADM(5),"^",2),?TAB2," Phone: ",VAPA(8)
55 Q
56 ;
57EM S VAROOT="VAEC",VAOA("A")=1 D OAD^VADPT K VAROOT ;emergency contact info
58 S VAOA("A")=5 D OAD^VADPT ;patient employer info
59 W !,?TAB," Employer: ",VAOA(9)
60 W ?TAB2," E-Cont.: ",VAEC(9) I VAEC(10)'="" W " - ",VAEC(10)
61 W !?TAB+11,VAOA(1),?TAB2+11,VAEC(1)
62 I VAEC(2)'=""!(VAOA(2)'="") W !?TAB+11,VAOA(2),?TAB2+11,VAEC(2)
63 I VAEC(3)'=""!(VAOA(3)'="") W !?TAB+11,VAOA(3),?TAB2+11,VAEC(3)
64 W !?TAB+11,VAOA(4),$S(VAOA(4)'="":", ",1:""),$P($G(^DIC(5,+VAOA(5),0)),"^",2)," ",VAOA(6)
65 W ?TAB2+11,VAEC(4),$S(VAEC(4)'="":", ",1:""),$P($G(^DIC(5,+VAEC(5),0)),"^",2)," ",VAEC(6)
66 W !?TAB," Phone: ",VAOA(8),?TAB2," Phone: ",VAEC(8)
67 Q
68 ;
69INS ; -- print insurance info
70 N IBINS,IBCNT,I
71 I '$D(IBDT) S IBDT=DT
72 D ALL^IBCNS1(DFN,"IBINS",1,IBDT)
73 I $G(IBINS(0))<1 W !,?TAB,"No Insurance Information",!!! G INSQ
74 S MAX=$S(IOSL<61:1,IOSL<67:2,1:3)
75 S I=0,IBCNT=0 F S I=$O(IBINS(I)) Q:'I S IBINS=IBINS(I,0) D I '$D(IBALLIN),IBCNT>MAX W !?TAB,"MORE......" Q
76 .S IBCNT=IBCNT+1
77 .I IBCNT>1 W !
78 .W !?TAB,"Ins. Co "_IBCNT_": ",$P($G(^DIC(36,+IBINS,0)),"^")
79 .S X=$G(^DIC(36,+IBINS,.13)),X=$S($P(X,"^",3)'="":$P(X,"^",3),1:$P(X,"^"))
80 .W ?TAB2," Phone: ",X
81 .W !?TAB," Subsc.: ",$P(IBINS,"^",17)
82 .W ?TAB2," Type: ",$E($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBINS,"^",18),0)),"^",9),0)),"^"),1,20)
83 .W !?TAB,"Subsc. ID: ",$P(IBINS,"^",2)
84 .W ?TAB2," Group: ",$$GRP^IBCNS($P(IBINS,"^",18))
85INSQ Q
86 ;
87LINE ; -- write a line
88 W !,$$L("-",IOM)
89 Q
90 ;
91TWOL ; -- write two underlines
92 W !?TAB,$$L("_",IOM-TAB),!!?TAB,$$L("_",IOM-TAB)
93 Q
94 ;
95L(C,L) ; -- output line
96 S:$G(C)="" C="-"
97 S:$G(L)="" L=IOM
98 Q $TR($J(" ",L)," ",C)
99 ;
100ATYPE(X) ; -- Admission Type Expand Set
101 ; -- input internal form (number)
102 ; -- output external form
103 Q $P($P($P(^DD(356,.07,0),"^",3),+$G(X)_":",2),";",1)
Note: See TracBrowser for help on using the repository browser.