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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IBTRC4 ;ALB/AAS - CLAIMS TRACKING - PRINT REVIEW WORKSHEET ; 14-JUL-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% G RWM
6 ;
7RW ; -- print Review Worksheet from lm action from ibtre
8 D FULL^VALM1
9 D PRINT(DFN)
10RWQ S VALMBCK="R" Q
11 ;
12RWM ; -- print review worksheet from menu
13 W !,"Print Insurance Review Worksheet",!
14RWM1 ;
15 ; -- select patient
16 D PAT^IBCNSM I $D(VALMQUIT)!('$G(DFN)) G RWMQ
17 ;
18 ; -- print the sheet, reask patient
19 I $G(DFN) D PRINT(DFN),RWMQ W !! G RWM1
20 Q
21 ;
22RWMQ K I,J,X,Y,DIC,DFN,VALMQUIT
23 Q
24 ;
25PRINT(DFN) ; -- print one worksheet
26 ;
27 N I,J,X,Y,VA,VA200,VAERR,VAIN,IBINS,IBCNT,IBX,TAB,TAB2,POP
28 ;
29 S %ZIS="QM" D ^%ZIS G:POP PRINTQ
30 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ1^IBTRC4",ZTSAVE("DFN")="",ZTSAVE("IB*")="",ZTDESC="IB - Print Review Worksheet" D ^%ZTLOAD K ZTSK D HOME^%ZIS G PRINTQ
31 ;
32 U IO
33 ;
34DQ1 D DQ G RWMQ
35 Q
36DQ ; -- entry point from taskman
37 S VA200="",TAB=3,TAB2=$S(IOM>120:80,1:44)
38 D INP^VADPT,PID^VADPT,INS
39 ;
40TOP W !!,?(IOM-26/2),"INSURANCE REVIEW WORKSHEET",!?(IOM-22),$$HTE^XLFDT($H)
41 W !!?TAB," Specialty: ",$E($P($G(VAIN(3)),"^",2),1,23)
42 W ?TAB2+8,"Ward: ",$P($G(VAIN(4)),"^",2)
43 W !!?TAB," Name: ",$E($P($G(^DPT(DFN,0)),"^",1),1,23)
44 W ?TAB2,"Insurance Co: ",$G(IBX(1))
45 W !?TAB," Pt ID: ",VA("PID"),?(TAB2+14),$G(IBX(2))
46 W !?TAB," DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3)),?(TAB2+14),$G(IBX(3))
47 W !!?TAB,"Admission Date: ",$P($G(VAIN(7)),"^",2)
48 W ?TAB2," DC Date: ________ LOS: _____"
49 W !!?TAB," Attending MD: ",$E($P($G(VAIN(11)),"^",2),1,20)
50 W ?TAB2," Primary MD: ",$E($P($G(VAIN(2)),"^",2),1,20)
51 W !!?TAB,"Complaint/Hist: ",$$LINE("_",IOM-TAB-17)
52 W !!?TAB," ",$$LINE("_",IOM-TAB-17)
53 W !!?TAB," Treatment: ",$$LINE("_",IOM-TAB-17)
54 W !!?TAB," ",$$LINE("_",IOM-TAB-17)
55 I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
56 ;
57MID ;
58 W !!?TAB,$$LINE("=",IOM-TAB-1)
59 W !?TAB,"|Date",?12,"|Diagnosis",?37,"|Procedure",?64,"|DRG",?71,"|LOS |" W:IOM>130 "Notes",?130,"|"
60 I $E(IOST,1,2)'="C-" W $C(13)," ",$$LINE("_",IOM-TAB-1)
61 F I=1:1:8 D BLINE
62 W !?TAB,$$LINE("=",IOM-TAB-1)
63 I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
64 ;
65BOT ;
66 W !?TAB,"|Insurance Contact: ",$$LINE("_",26)," Phone: ",$$LINE("_",20),"|"
67 W !?TAB,"|",$$LINE("_",IOM-TAB-3),"|"
68 W !?TAB,"|Date |Comments (#day approved, next review date, etc.)",?IOM-2,"|"
69 I $E(IOST,1,2)'="C-" W $C(13)," ",$$LINE("_",IOM-TAB-1)
70 F I=1:1:5 D BLINE2
71 W !?TAB,$$LINE("=",IOM-TAB-1)
72 W !!?TAB,"Reviewer: _____________________________________ Date: ____________________"
73 I $E(IOST,1,2)="C-" D PAUSE^VALM1 I $D(DIRUT) G PRINTQ
74 ;
75PRINTQ W !
76 I $D(ZTQUEUED) S ZTREQ="@" Q
77 D ^%ZISC
78 Q
79 ;
80LINE(CHAR,LEN) ; -- return line of length len of character char
81 I '$G(LEN) S LEN=IOM
82 I $G(CHAR)="" S CHAR="-"
83 Q $TR($J(" ",LEN)," ",CHAR)
84 ;
85BLINE ; -- print line with bars
86 W !?TAB,"| | | | | |" W:IOM>130 " |"
87 W !?TAB,"|________|________________________|__________________________|______|______|" W:IOM>130 "___________________________________________________|"
88 Q
89BLINE2 ; -- print line with bars
90 W !?TAB,"| | " W:IOM<130 "|" W:IOM>130 " |"
91 W !?TAB,"|________|_________________________________________________________________" W:IOM<130 "|" W:IOM>130 "____________________________________________________|"
92 Q
93 ;
94INS ; -- print insurance info
95 D ALL^IBCNS1(DFN,"IBINS",1,$S(+VAIN(8):+VAIN(8),1:DT))
96 K IBX
97 I $G(IBINS(0))<1 S IBX(1)="No Active Insurance" G INSQ
98 S I=0,IBCNT=0 F S I=$O(IBINS(I)) Q:'I S IBCNT=$G(IBCNT)+1,IBX(IBCNT)=$E($P($G(^DIC(36,+IBINS(I,0),0)),"^"),1,20) Q:IBCNT>3
99 ;
100INSQ Q
Note: See TracBrowser for help on using the repository browser.