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

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

initial load of WorldVistAEHR

File size: 4.6 KB
RevLine 
[613]1IBTOBI ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93
2 ;;2.0;INTEGRATED BILLING;**91,160,199,309,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% I '$D(DT) D DT^DICRW
6 W !!,"Bill Preparation Report for a Single Visit"
7 D END
8 ;
9PAT ; -- Select patient
10 W !!
11 S DIC="^DPT(",DIC(0)="AEQM"
12 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
13 D ^DIC K DIC I +Y<1 G END
14 S DFN=+Y
15 ;
16VSIT ;
17 ; -- get claims tracking visit entry
18 D TRAC^IBTRV K IBY
19 I '$G(IBTRN) G END
20 ;
21DEV ; -- select device, run option
22 W !
23 S %ZIS="QM" D ^%ZIS G:POP END
24 I $D(IO("Q")) S ZTRTN="DQ^IBTOBI",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Bill Preparation Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G PAT
25 ;
26 U IO
27 D ONE,END G PAT
28 Q
29DQ ; -- task man entry point
30 D ONE
31 ;
32END ; -- Clean up
33 W !
34 I $D(ZTQUEUED) S ZTREQ="@" Q
35 D ^%ZISC
36 K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,DIRUT,DUOUT,IBCNT,IBI,IBJ,IBNAR,IBTNOD,IBTRCD1,IBTRTP,IBDA
37 D KVAR^VADPT
38 Q
39ONE ; -- print one billing report from ct
40 S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
41 D PID^VADPT
42 S IBTRND=$G(^IBT(356,+IBTRN,0)),IBTRND1=$G(^(1))
43 S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
44 D HDR,SECT1,^IBTOBI1
45 Q
46 ;
47HDR ; -- Print header for billing report
48 Q:IBQUIT
49 I '$D(VA("PID")) N I,J D PID^VADPT
50 I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
51 I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
52 S IBPAG=IBPAG+1
53 W !,$S($D(IBCTHDR):IBCTHDR,1:"Bill Preparation Report"),?(IOM-33),"Page ",IBPAG," ",IBHDT
54 W !!,$E($P($G(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3),1)
55 W !,$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))," on ",$$FMTE^XLFDT($P(IBTRND,"^",6),1)
56 W !,$TR($J(" ",IOM)," ","-")
57 Q
58 ;
59SECT1 ; -- Section 1 - Visit info Region / misc billing info
60 N IBD
61 W !," Visit Information "
62 S IBD(1,1)=" Visit Type: "_$P(IBETYP,"^")
63 S X=$P(IBETYP,"^",3) I 'X W !,"No Visit Selected" Q
64 D @X
65 D MBI
66 S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?44,$E($G(IBD(I,2)),1,36)
67 W !?4,$TR($J(" ",IOM-8)," ","-"),!
68 Q
691 ; -- visit region for admission or scheduled admission
70 S IBDISDT=""
71 I $P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17) S VAINDT=+$G(^DGPM(+$P(IBTRND,"^",5),0)),IBDISDT=+$G(^DGPM(+$P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17),0))
72 I '$D(VAIN) S VA200="" D INP^VADPT
73 I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
74 S IBD(2,1)="Admission Date: "_$P(VAIN(7),"^",2)
75 S IBD(3,1)=" Ward: "_$P(VAIN(4),"^",2)
76 S IBD(4,1)=" Specialty: "_$P(VAIN(3),"^",2)
77 S IBD(5,1)="Discharge Date: "_$$FMTE^XLFDT(IBDISDT,1)
78 Q
792 ; -- visit region for outpatient care
80 N IBOE,IBOE0
81 S IBOE=$P(IBTRND,"^",4),IBOE0=$$SCE^IBSDU(+IBOE)
82 S IBD(2,1)=" Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
83 I +IBOE<1 S IBD(3,1)=" No Outpatient Encounter Found" Q
84 S IBD(3,1)=" Clinic: "_$P($G(^SC(+$P(IBOE0,U,4),0)),"^")
85 S IBD(4,1)=" Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,U,12))
86 S IBD(5,1)=" Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,U,10))
87 S IBD(6,1)=" Special Cond: "_$$ENCL^IBTRED(IBOE)
88 Q
89 ;
903 ; -- visit region for rx refill
91 N PSONTALK,PSOTMP,PSORXN,PSOFILL
92 S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
93 S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
94 ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
95 I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
96 S IBD(2,1)="Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E"))
97 I $P(IBTRND,"^",10)=0 S IBD(3,1)=" Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
98 I +$P(IBTRND,"^",10) S IBD(3,1)=" Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
99 S IBD(4,1)=" Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E"))
100 S IBD(5,1)=" Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8)
101 S IBD(6,1)=" Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8)
102 S IBD(7,1)=" NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10))
103 S IBD(8,1)=" Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E"))
104 Q
105 ;
1064 ; -- Visit region for prosthetics
107 D 4^IBTOBI4
108 Q
109 ;
110MBI ; -- Misc. billing info
111 S IBD(1,2)=" Visit Billable: "_$S('$P(IBTRND,"^",19):"YES",1:"NO-"_$$EXPAND^IBTRE(356,.19,$P(IBTRND,"^",19)))
112 S IBD(2,2)=" Second Opinion: "_$S('$P(IBTRND,"^",14):"NOT REQUIRED",1:$S('$P(IBTRND,"^",15):"REQUIRED-NOT OBTAINED",1:"OBTAINED"))
113 S IBD(3,2)=" Auto Bill Date: "_$$FMTE^XLFDT($P(IBTRND,"^",17),1)
114 S IBD(4,2)="Special Consent: ROI "_$S('$P(IBTRND,"^",31):"NOT DETERMINED",1:$$EXPAND^IBTRE(356,.31,$P(IBTRND,"^",31)))
115 S IBD(5,2)="Special Billing: "_$$EXPAND^IBTRE(356,.12,$P(IBTRND,"^",12))
116 Q
117 ;
Note: See TracBrowser for help on using the repository browser.