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

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1IBCNSC41 ;ALB/TMP - INSURANCE PLAN SCREEN UTILITIES (CONT) ; 15-AUG-95
2 ;;Version 2.0 ; INTEGRATED BILLING ;**43**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5HDR ; -- Plan detail screen header
6 S VALMHDR(1)="Plan Information for: "_$E($P($G(^DIC(36,+$G(IBCPOLD),0)),"^"),1,20)_" Insurance Company",VALMHDR(2)=$J("",40)_"** Plan Currently "_$S($P(IBCPOLD,U,11):"Ina",1:"A")_"ctive **"
7 Q
8 ;
9HELP ; -- help code
10 S X="?" D DISP^XQORM1 W !!
11 Q
12 ;
13EXIT ; -- exit code
14 K VALMBCK,^TMP("IBCNSCP",$J)
15 D CLEAN^VALM10,CLEAR^VALM1
16 Q
17 ;
18LIMBLD(START,OFFSET,IBLCNT) ; Build actual limit display
19 N COV,COVD,COVFN,IBCNT,LEDT,LIM,LINE,X1,Z0
20 S LIM=0,LINE=3
21 D SET^IBCNSC4(START,OFFSET," Plan Coverage Limitations ",IORVON,IORVOFF)
22 D SET^IBCNSC4(START+1,OFFSET," Coverage Effective Date Covered? Limit Comments")
23 D SET^IBCNSC4(START+2,OFFSET," -------- -------------- -------- --------------")
24 ;
25 F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM S COV=$P($G(^(LIM,0)),U),IBCNT=0,LEDT="" F S LEDT=$O(^IBA(355.32,"APCD",IBCPOL,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
26 .S COVFN=+$O(^IBA(355.32,"APCD",IBCPOL,LIM,+LEDT,"")),COVD=$G(^IBA(355.32,+COVFN,0))
27 .I COVD="" D SET^IBCNSC4(START+LINE,OFFSET," "_$E(COV_$J("",18),1,18)_$J("",19)_"BY DEFAULT") S LINE=LINE+1 Q ;No entry in file for this coverage
28 .S IBCNT=IBCNT+1
29 .S X1=" "_$E($S(IBCNT=1:COV,1:"")_$J("",18),1,18) ;Don't dup category
30 .S X1=X1_" "_$E($$DAT1^IBOUTL($P(LEDT,"-",2))_$J("",8),1,8)_$J("",9)_$S($P(COVD,U,4):$S($P(COVD,U,4)<2:"YES"_$J("",8),$P(COVD,U,4)=2:"CONDITIONAL",1:"UNKNOWN "),1:"NO"_$J("",9))_$J("",5)
31 .D SET^IBCNSC4(START+LINE,OFFSET,X1)
32 .I '$O(^IBA(355.32,COVFN,2,0)) S LINE=LINE+1
33 .S Z0=0 F S Z0=$O(^IBA(355.32,COVFN,2,Z0)) Q:'Z0 D SET^IBCNSC4(START+LINE,OFFSET+54,$G(^IBA(355.32,COVFN,2,Z0,0))) S LINE=LINE+1
34 ;
35 S IBLCNT=LINE-3
36 Q
37 ;
Note: See TracBrowser for help on using the repository browser.