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

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1IBCEF31 ;ALB/ESG - FORMATTER SPECIFIC BILL FLD FUNCTIONS - CONT ;14-NOV-03
2 ;;2.0;INTEGRATED BILLING;**155,296,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7ALLTYP(IBIFN) ; returns codes to translate to ALL ins types on a bill
8 ; IBIFN = ien of bill
9 N IBX,Z
10 F Z=1:1:3 S $P(IBX,U,Z)=$$INSTYP(IBIFN,Z)
11 ; IBX = primary code^secondary code^tertiary code
12 Q IBX
13 ;
14INSTYP(IBIFN,SEQ) ; Returns insurance type code for an ins on a bill
15 ; IBIFN = ien of bill
16 ; SEQ = sequence (1,2,3) of insurance wanted - prim, second, tert
17 ; Default is current insurance co
18 ;
19 N IBA,Z
20 ;
21 I '$G(SEQ) S SEQ=$$COBN^IBCEF(IBIFN)
22 S Z=+$G(^DGCR(399,IBIFN,"I"_SEQ))
23 ;Codes 1:HMO;2:COMMERCIAL;3:MEDICARE;4:MEDICAID;5:GROUP POLICY;9:OTHER
24 I Z D
25 . S IBA=$P($G(^DIC(36,Z,3)),U,9)
26 . I $$MCRWNR^IBEFUNC(Z) S IBA=3 ; force Medicare (WNR) definition to be correct
27 . I IBA="" S IBA=5 ;Default is group policy - 5 if blank
28 ;
29 Q $G(IBA)
30 ;
31POLTYP(IBIFN,IBSEQ) ; Returns ins electronic policy type code for one
32 ; ins policy on a bill
33 ; IBIFN = ien of bill
34 ; IBSEQ = sequence (1,2,3) of ins policy wanted - prim, second, tert
35 ; Default is current insurance co
36 ;
37 N IBPLAN,IBPLTYP
38 ;
39 I '$G(IBSEQ) S IBSEQ=+$$COBN^IBCEF(IBIFN)
40 S IBPLAN=$G(^IBA(355.3,+$P($G(^DGCR(399,IBIFN,"I"_IBSEQ)),U,18),0))
41 S IBPLTYP=$P(IBPLAN,U,15)
42 ;
43 ; esg - 06/30/05 - IB*2.0*296 - Force Medicare (WNR) to be correct
44 I $$WNRBILL^IBEFUNC(IBIFN,IBSEQ),$$FT^IBCEF(IBIFN)=2 S IBPLTYP="MB" ; CMS-1500 ----> Medicare Part B
45 I $$WNRBILL^IBEFUNC(IBIFN,IBSEQ),$$FT^IBCEF(IBIFN)=3 S IBPLTYP="MA" ; UB-04 -------> Medicare Part A
46 ;
47 I IBPLTYP="" S IBPLTYP="CI" ;Default is commercial - 'CI'
48 I IBPLTYP="MX" D
49 . I $P(IBPLAN,U,14)'="","AB"[$P(IBPLAN,U,14) S IBPLTYP="M"_$P(IBPLAN,U,14) Q
50 . S IBPLTYP="CI"
51 Q $G(IBPLTYP)
52 ;
53ALLPTYP(IBIFN) ; returns insurance policy type codes for ALL ins on a bill
54 ; IBIFN = ien of bill
55 N IBX,Z S IBX=""
56 F Z=1:1:3 I $D(^DGCR(399,IBIFN,"I"_Z)) S $P(IBX,U,Z)=$$POLTYP(IBIFN,Z)
57 ; IBX = primary code^secondary code^tertiary code
58 Q IBX
59 ;
60PGDX(DXCNT,IBX0,IBXDA,IBXLN,IBXCOL,IBXSIZE,IBXSAVE) ; Subroutine - Checks for Diagnosis Codes (Dx) beyond
61 ; the first four, that relate to the current Dx position passed in DXCNT.
62 ; This subroutine stores the Diagnosis Codes in output global using display parameters (IBXLN,IBXCOL)
63 ; If DXCNT is 1, check for Dx's 5,9,...etc & display on pages 2,3,...etc
64 ; If DXCNT is 2, check for Dx's 6,10,...etc & display on pages 2,3,...etc
65 ; If DXCNT is 3, check for Dx's 7,11,...etc & display on pages 2,3,...etc
66 ; If DXCNT is 4, check for Dx's 8,12,...etc & display on pages 2,3,...etc
67 ;
68 ; Input: DXCNT= position of current Dx (from 1 to 4)
69 ; IBX0= zero-level of file 364.7 of current Dx
70 ; IBXDA= ien# of file 364.6 of current Dx
71 ; IBXLN IBXCOL= line# & Column# of current Dx
72 ; IBXSIZE= size counter
73 ; IBXSAVE("DX")= local array with all Dx's on current bill
74 ;
75 N JUMP,IBPG,VAL
76 F JUMP=DXCNT+4:4 Q:'$D(IBXSAVE("DX",JUMP)) D ;
77 . ;calculate page number where Dx number JUMP will print
78 . S IBPG=JUMP\4+(JUMP#4>0)
79 . S VAL=$P($G(^ICD9(+IBXSAVE("DX",JUMP),0)),U) ; resolve Dx pointer
80 . S VAL=$$FORMAT^IBCEF3(VAL,$G(IBX0),$G(IBXDA)) ;format Dx value
81 . D SETGBL^IBCEFG(IBPG,IBXLN,IBXCOL,VAL,.IBXSIZE) ;store in output global
82 Q ;PGDX
83 ;
Note: See TracBrowser for help on using the repository browser.