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

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1IBECEAU5 ;ALB/BGA - Cancel/Edit/Add CALC Observation COPAY ; 17-MAY-2000
2 ;;2.0;INTEGRATED BILLING;**132,153,156,167,247**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Find the IB action type and outpatient copay rate for an inpatient Observation
6 ;
7OBS ; Called from EN^IBAMTD when adding an Inpatient Observation Copay
8 ;
9 ; Check to see if you have a clock
10 I '$G(IBCLDA) S IBCLDT=$P(IBADMDT,".") D CLADD^IBAUTL3 G:IBY<1 END
11 ; Calculate Outpatient COPAY Charge return IBATYP,IBCHG,IBDESC,IBRTED
12 ; setting IBTYPE=2 to designate all observation is specialty care
13 S (IBDT,IBADMDT)=$P(IBADMDT,"."),IBX="O",IBTYPE=2 D CHRG G:IBY<1 END
14 ; Set the SOFTLINK field = Admission Movment:405
15 S IBSL="405:"_IBA,IBUNIT=1,(IBFR,IBEVDT)=IBADMDT,IBTO=$P(IBDISDT,"."),IBEVDA="*"
16 ; Add the charge to ^IB set IBN= new charge's IEN
17 D ADD^IBECEAU3 G:IBY<1 END
18 ; Pass the charge to AR set IBTRAN and IBIL
19 S IBDUZ=DUZ D IBFLR^IBAMTS1
20END K IBFR,IBTO,IBTYPE
21 Q
22 ;
23CHRG ; Called from OPT^IBECEA33 when adding a obs copay from CANCEL/EDIT/ADD
24 ;
25 ; Input: Optional if no IBDT than default to DT
26 ; Output: IBATYP, IBCHG, IBDESC, IBRTED
27 ;
28 I '$D(IBDT) S IBDT=DT
29 D TYPE^IBAUTL2 ; Sets IBCHRG=Outpat Copay $ and IBRTED=effective DT of rate
30 Q:'IBCHG ; Error occurred sets IBY in TYPE^IBAUTL2
31 S IBBS=$$MCCRUTL^IBCRU1("OBSERVATION CARE",5)
32 S IBATYP=$P($G(^DGCR(399.1,+IBBS,0)),"^",7) I 'IBATYP S IBY="-1^IB008" Q
33 I $D(^IBE(350.1,+IBATYP,20)) X ^(20) ; sets IBDESC
34 Q
35 ;
36CLSF(DGMVP) ;
37 ; This Subroutine evaluates an Inpatient Admission for an Observation Speciality
38 ; where the patient has claimed exposure. The Special Inpatient Billing
39 ; case record is evaluated to detemine the status of the disposition
40 ; the results are than displayed on the Outpatient Events Reports
41 ;
42 N DGIEN,DG0,IBDISP,IBOUT,IBREAS,IBTYP
43 Q:'DGMVP!('$D(^IBE(351.2,"AC",DGMVP))) ; no special case record on file
44 S DGIEN=0,DGIEN=$O(^IBE(351.2,"AC",DGMVP,DGIEN)) Q:'DGIEN
45 S DG0=$G(^IBE(351.2,DGIEN,0)) ; Special Inpatient Billing Case Record
46 Q:$P(DG0,U,8)&('$P(DG0,U,7)) ; Case disposed care not related to Condition
47 S IBTYP=$P(DG0,U,3)
48 S IBTYP=$$UCCL^IBAMTI(IBTYP) S:IBTYP="SPECIAL" IBTYP="SPECIAL CASE"
49 S IBOUT="* Patient Claims EPISODE OF CARE related to: "_IBTYP
50 I '$P(DG0,U,8) S IBDISP="** STATUS - Case has not been DISPOSITIONED" D PRINT Q
51 I $P(DG0,U,8),$P(DG0,U,7) D
52 . S IBDISP="** Case has been DIPOSITIONED and Care is NOT BILLABLE"
53 . S IBREAS=$G(^IBE(351.2,DGIEN,1,0))
54 . D PRINT
55 Q
56 ;
57PRINT ;
58 I IBLINE>55 D HDR^IBOVOP2 W !,IBFLD1,!?5,IBFLD2
59 I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR^IBOVOP2 W !,IBFLD1,!?5,IBFLD2
60 W !!,?5,IBOUT
61 W:$G(IBDISP)]"" !,?5,IBDISP ; Writes the status of the disposition
62 I $G(IBREAS)]"" D
63 . W !,?5,"Reason Not Billable: ",$E(IBREAS,1,55) ; Writes Reason Not Billed
64 Q
65 ;
66FEE ; This Subroutine permits a Clerk to add a DG FEE SERVICE (OPT)
67 ; when the value of the fee for service is less than the normal
68 ; Outpatient Copayment.
69 ;
70 Q:'$G(IBAFEE)!('$G(IBCHG))
71 ; Reset ibdesc="DG FEE SERVICE (OPT) NEW", ibatyp=57
72 ; before adding entry from ADD^IBECEAU3 to ^IB
73 S IBATYP=IBAFEE I $D(^IBE(350.1,+IBATYP,20)) X ^(20)
74 N DIR,X,Y,DIRUT
75 S DIR(0)="350,.07",DIR("A")="Fee Amount"
76 S DIR("B")=$S(IBCHG?1N.N1"."1N:IBCHG_0,1:IBCHG)
77 S DIR("T")=180,DIR("?")=" "
78 S DIR("?",1)=" *** The Fee for Service can not be LESS than $1.00 or"
79 S DIR("?",2)=" *** GREATER than $"_$S(IBCHG?1N.N1"."1N:IBCHG_0,1:IBCHG)_"."
80 D ^DIR I $G(DIRUT) S IBY=-1 Q
81 I $G(Y)>50.8!($G(Y)<1) D G FEE
82 . W !,?10,"*** The Fee for Service can not be GREATER than $"_$S(IBCHG?1N.N1"."1N:IBCHG_0,1:IBCHG)
83 . W !,?10,"*** AND must be GREATER than $.99==> Please try Again"
84 S:$G(Y) IBCHG=Y
85 Q
86 ;
87IBOVOP(IBDATE) ;
88 ; This Subroutine expands the functions of the Outpatient Events Report
89 ; by adding Inpatient Observation Admissions/Discharges to the the report.
90 ; Find Admissions or Discharges Associated with Inpatient Observation
91 ; Specialities and Load them into ^TMP("IBOVOP",$J) to be printed
92 ; by ^IBOVOP the Outpatient Events Report.
93 ;
94 Q:'$G(IBDATE)
95 N DGPM0,DGMVP,IBDATE1,IBDFN,IBI,IBENDDT,IBSPEC
96 N IBFLD1,IBFLD2,IBFLD3,IBFLD4,IBFLD5,IBSUB3,IBSUB4,IBSUB5,IBSUB6
97 S IBDATE1=$P(IBDATE,"."),IBI=($P(IBDATE,".")-1)+.99999
98 S IBENDDT=IBDATE1+.9999
99 F S IBI=$O(^DGPM("B",IBI)) Q:'IBI!(IBI>IBENDDT) D
100 . S DGMVP=0 F S DGMVP=$O(^DGPM("B",IBI,DGMVP)) Q:'DGMVP D
101 . . S DGPM0=$G(^DGPM(DGMVP,0)) Q:$P(DGPM0,U,2)'=1
102 . . S IBTYP=$P(DGPM0,U,2) ; 1=Admission
103 . . S IBSPEC=$$MVT^DGPMOBS(DGMVP) Q:+IBSPEC<1 ; quite not OBS
104 . . S IBDFN=$P(DGPM0,U,3) Q:'IBDFN
105 . . Q:$$BILST^DGMTUB(IBDFN)<($P(+DGPM0,".")) ; quite not MT billable
106 . . S IBSUB3=$$FLD1^IBOVOP1(IBDFN) Q:IBSUB3="" ; subscript 3 PT name
107 . . S IBSUB4="OBS ADMIS"
108 . . S IBSUB5=$$FLD3^IBOVOP1(+DGPM0) Q:IBSUB5=""
109 . . S IBSUB6=0
110 . . S IBFLD1=$E($P(IBSPEC,U,3),U,30) ; Treating Speciality
111 . . S IBFLD2=""
112 . . S IBFLD3=$S($P(DGPM0,U,17):"DISCHARGED",1:"ADMISSION")
113 . . S IBFLD4=IBDFN,IBFLD5="",IBFLD6=DGMVP
114 . . ; Set the Global for the Outpatient Event Report
115 . . S ^TMP("IBOVOP",$J,IBSUB3,IBSUB4,IBSUB5,IBSUB6)=IBFLD1_U_IBFLD2_U_IBFLD3_U_IBFLD4_U_IBFLD5_U_IBFLD6
116 Q
Note: See TracBrowser for help on using the repository browser.