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

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1IBCF22 ;ALB/ARH - HCFA 1500 19-90 DATA (gather other data) ;12-JUN-93
2 ;;2.0;INTEGRATED BILLING;**52,80,122,51,210**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; requires DFN, IBIFN, IB(0)
6 F IBI="C","U","U1","U2","UF2" S IB(IBI)=$G(^DGCR(399,IBIFN,IBI))
7 S IBFLD(12)="PUBLIC LAW 99-272/SECTION 1729 TITLE 38"
8 S IBFLD(13)="PUBLIC LAW 99-272"
9DATES S IBFLD(14)=$$DATE($$EVENT(IBIFN))
10 I $G(IBFLD(15))="",IBIFN'=$P(IB(0),U,17) S IBFLD(15)=$$DATE($P($G(^DGCR(399,+$P(IB(0),U,17),0)),U,3))
11 S IBFLD("16A")=$$DATE($P(IB("U"),U,16)),IBFLD("16B")=$$DATE($P(IB("U"),U,17))
12 S:$$NEEDMRA^IBEFUNC(IBIFN) IBFLD(17)="Dept. Of Veterans Affairs"
13 I $P(IB(0),U,5)<3 S IBFLD("18A")=$$DATE($P(IB("U"),U,1)),IBFLD("18B")=$$DATE($P(IB("U"),U,2))
14 I $P(IB(0),U,5)>2 S VAINDT=$P(IB(0),U,3) D INP^VADPT I +VAIN(1) D
15 . S IBFLD("18A")=$$DATE(VAIN(7)),IBFLD("18B")=$$DATE(+$G(^DGPM(+$P($G(^DGPM(+VAIN(1),0)),U,17),0)))
16 K VAINDT,VAIN
17 S IBFLD(19)="THE UNDERSIGNED CERTIFIES TREATMENT IS NOT FOR A SERVICE-CONNECTED CONDITION"
18 S IBFLD(20)=0
19 ;
20DX ;S X=14 F IBI="21A","21B","21C","21D" S IBFLD(IBI)=$P($G(^ICD9(+$P(IB("C"),U,X),0)),U,1),X=X+1
21 ;F IBI="21A","21B","21C","21D" S IBFLD(IBI)=""
22 ;N IBINDXX D SET^IBCSC4D(IBIFN,"",.IBINDXX) S X=0,Y="21@" D
23 ;. F S X=$O(IBINDXX(X)) Q:'X S Y=$O(IBFLD(Y)) Q:+Y'=21 S IBFLD(Y)=$P($G(^ICD9(+IBINDXX(X),0)),U,1)
24 ;
25 N IBDXX,IBPOX
26 D SET^IBCSC4D(IBIFN,.IBDXX,.IBPOX)
27 S X=0 F IBI=1:1:4 S IBFLD(21,IBI)="" I IBI'>$P(IBPOX,U,2) D
28 . S X=$O(IBPOX(X)) Q:X=""
29 . S IBFLD(21,IBI)=$P($$ICD9^IBACSV(+IBPOX(X)),U)
30 . S IBDXI(+$G(IBDXX(+IBPOX(X))))=IBI
31 ;
32 S IBFLD(23)=$P(IB("U"),U,13)
33 ;
34 D ^IBCF23 ; block 24
35 ;
36 S IBFLD(25)=$P($G(^IBE(350.9,1,1)),U,5)
37 S IBFLD(26)=$$BN1^PRCAFN(IBIFN)
38 S IBFLD(28)=+IB("U1")
39 S IBFLD(29)=+$P(IB("U1"),U,2)
40 S IBFLD(30)=IBFLD(28)-IBFLD(29)
41LAST3 S IBFLD(31)=$G(^DGCR(399,IBIFN,"UF2")) ;assuming there are 3 available lines
42 S X=+$P($G(^IBE(350.9,1,0)),U,2),Y=$G(^DIC(4,X,0)),IBI=1 I Y'="" D
43 . S IBFLD(32,1)=$P(Y,U,1),IBX=+$P(Y,U,2),Y=$G(^DIC(4,X,1))
44 . S IBFLD(32,2)=$P(Y,U,1) I $P(Y,U,2)'="" S IBFLD(32,2)=IBFLD(32,2)_", "_$P(Y,U,2)
45 . S IBFLD(32,3)=$P(Y,U,3),IBFLD(32,"X")=$$STATE^IBCF2(IBX)_" "_$P(Y,U,4)
46 S X=$G(^IBE(350.9,1,2))
47 S IBFLD(33,1)=$P(X,U,1),IBFLD(33,2)=$P(X,U,2)
48 S IBFLD(33,3)=$P(X,U,3),IBFLD(33,"X")=$$STATE^IBCF2($P(X,U,4))_" "_$P(X,U,5)
49 S IBFLD(33,4)=$P(X,U,6)
50 ;
51END Q
52 ;
53EVENT(IBIFN,IBXSAVE,IBERR,IBD) ; The event date for box 14 on the
54 ; HCFA 1500
55 ; IBIFN = bill ien
56 ; IBXSAVE = the array returned by the output formatter for data element
57 ; N-OCCURRENCE CODES
58 ; Returns IBERR=1 if passed by reference meaning more than one condition
59 ; has been found
60 ; IBD("LMP"), IBD("ACC"), IBD("ONS"), IBD("EVT") returned with
61 ; Last menstrual period date, accident date, date of onset,
62 ; event date if IBD passed by reference
63 ; Function returns the appropriate date
64 ;
65 N Z,Z0,IBX,IBF,A
66 ;
67 ; Default if no applicable occurrence codes found is event date on bill
68 S IBX=$P($G(^DGCR(399,IBIFN,0)),U,3),IBF=0 S IBD("EVT")=IBX
69 ;
70 I '$D(IBXSAVE("OCC")) D F^IBCEF("N-OCCURRENCE CODES",,,IBIFN)
71 S Z=0 F S Z=$O(IBXSAVE("OCC",Z)) Q:'Z S Z0(+IBXSAVE("OCC",Z))=$P(IBXSAVE("OCC",Z),U,2)
72 I $O(Z0(5.99),-1) D
73 . S A=$O(Z0(5.99),-1),IBF=IBF+1 ;Accident codes 1-5
74 . S IBD("ACC")=Z0(A) S:IBF'>1 IBX=Z0(A)
75 I $D(Z0(10)) S IBF=IBF+1,IBD("LMP")=IBX S:IBF'>1 IBX=Z0(10) ;Last Menstrual period
76 I $D(Z0(11)) S (IBD("ONS"),IBX)=Z0(11),IBF=IBF+1 ;Onset of Illness
77 ;
78 S IBERR=(IBF>1)
79 Q IBX
80 ;
81DATE(X) ; format date(X) as MM DD YYYY
82 Q $$DATE^IBCF2(X,1)
83 ;
Note: See TracBrowser for help on using the repository browser.