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

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1IBCECSA7 ;ALB/ESG - VIEW EOB SCREEN CONTINUED ;26-JUN-2003
2 ;;2.0;INTEGRATED BILLING;**135,155**;21-MAR-1994
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q ; Must be called at proper entry points
6 ;
7LLVLA ;line level adjustment
8 Q:'$G(IBSRC) ; no MRA
9 D MRALLA^IBCECSA5
10 Q
11RDATA ;
12 I '$G(IBSRC) Q ; no review data for IB/MRA
13 I $G(IBSRC) Q ; no review data for AR either
14 N IBRM,IBREC,IBFLG,IBFST
15 S IB=$$SETSTR^VALM1("REVIEW DATA:","",1,50)
16 D SET(IB)
17 D CNTRL^VALM10(VALMCNT,1,12,IORVON,IORVOFF)
18 S ^TMP("IBCECSD",$J,"X",8)=VALMCNT
19 S (Y,IBFLG)=0 F S Y=$O(^IBM(361.1,IBCNT,21,Y)) Q:'Y D
20 . S IBREC=$G(^IBM(361.1,IBCNT,21,Y,0)),IBFLG=1
21 . D SET(" REVIEW DATE/TIME: "_$$DAT1^IBOUTL($P(IBREC,U),1))
22 . S Z=0,IBFST=1 F S Z=$O(^IBM(361.1,IBCNT,21,Y,1,Z)) Q:'Z D
23 .. S IBRM=$G(^IBM(361.1,IBCNT,21,Y,1,Z,0))
24 .. D:IBFST SET(" COMMENT:"_$E(IBRM,1,68))
25 .. D TXT^IBCECSA5(IBRM,68,11)
26 .. S IBFST=0
27 D:'IBFLG SET(" NONE")
28 Q
29 ;
30ARCP ; A/R corrected payment data from splitting payment in EOB Worklist
31 N Z,Z0
32 I '$O(^IBM(361.1,IBCNT,8,0)) Q
33 S IB=$$SETSTR^VALM1(" **A/R CORRECTED PAYMENT DATA:","",1,50)
34 D SET(IB)
35 I '$G(IBSRC) D
36 . D CNTRL^VALM10(VALMCNT,1,27,IORVON,IORVOFF)
37 . S ^TMP("IBCECSD",$J,"X",5)=VALMCNT
38 D SET(" TOTAL AMT PD: "_$J(+$P($G(^IBM(361.1,IBCNT,1)),U,1),"",2))
39 S Z=0 F S Z=$O(^IBM(361.1,IBCNT,8,Z)) Q:'Z S Z0=$G(^(Z,0)) D
40 . S IB=$E($J("",6)_$S($P(Z0,U,3):$$BN1^PRCAFN(+$P(Z0,U,3)),1:"[suspense]"_$P(Z0,U))_$J("",25),1,25)_" "_$J(+$P(Z0,U,2),"",2)
41 . D SET(IB)
42 Q
43 ;
44INSINF(IBREC,CNT,IBCNT) ; Extract insured information (moved from IBCECSA6)
45 N IB,IBZ,IBSEQ,IBREL,Z,Z0
46 S IBSEQ=+$$COBN^IBCEF(IBREC)
47 S IB=$$SETSTR^VALM1("Patient Name: "_$P($G(^DPT(+$P($G(^DGCR(399,IBREC,0)),U,2),0)),U),"",2,39)
48 D F^IBCEF("N-ALL INSURED PT RELATION","IBZ",,IBREC)
49 S IBREL=$G(IBZ(IBSEQ))
50 S IB=$$SETSTR^VALM1("Pt. Relation : "_$$EXTERNAL^DILFD(2.312,16,"",IBREL),IB,41,38)
51 D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
52 S Z=2,Z0=39,IB=""
53 I +IBREL'=1 D
54 . D F^IBCEF("N-ALL INSURED FULL NAMES","IBZ",,IBREC)
55 . S IB=$$SETSTR^VALM1("Insured Name: "_$G(IBZ(IBSEQ)),IB,Z,Z0)
56 . S Z=41,Z0=38
57 D F^IBCEF("N-ALL INSURANCE NUMBER","IBZ",,IBREC)
58 S IB=$$SETSTR^VALM1("Insured ID "_$S(Z=41:" ",1:"")_": "_$G(IBZ(IBSEQ)),IB,Z,Z0)
59 D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
60 Q
61 ;
62SET(IB,IBSAV) ;
63 I '$G(IBSAV) D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
64 Q
65 ;
Note: See TracBrowser for help on using the repository browser.