source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGIBDSP.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: 2.0 KB
Line 
1DGIBDSP ;ALB/SCK - FORMATTED INSURANCE DISPLAY ; 16-JUNE-04
2 ;;5.3;Registration;**570,670**;Aug 13, 1993
3 ; This routine replaces the supported API DISP^IBCNS which provided a formatted
4 ; display of patient insurance information. This functionality was removed
5 ; when DBIA10146 was retired.
6 ;
7 Q
8 ;
9DISP ;-Display all insurance company information
10 ; -input DFN
11 ; -input DGSTAT [optional] Defaults to "RAB" if not defined.
12 ;
13 N DGDTIN
14 Q:'$D(DFN) D:'$D(IOF) HOME^%ZIS
15 ;
16 N X,DGINS,DGX,DGRTN,DGERR,DGY
17 ;
18 I '$D(DGSTAT) S DGSTAT="RAB"
19 S DGX=$$INSUR^IBBAPI(DFN,"",DGSTAT,.DGRTN,"*")
20 S:DGX<0 DGERR=$O(DGRTN("IBBAPI","INSUR","ERROR",0))
21 ;
22 D HDR
23 I $G(DGERR) W !?6,DGRTN("IBBAPI","INSUR","ERROR",DGERR) G DISPQ
24 I 'DGX W !," No Insurance Information" G DISPQ
25 ;
26 M DGINS=DGRTN("IBBAPI","INSUR")
27 S DGY=0
28 F S DGY=$O(DGINS(DGY)) Q:'DGY D D1(DGY)
29 ;
30DISPQ W ! I $D(DGRTN("BUFFER")) D
31 . I DGRTN("BUFFER")>0 W !?17,"*** Patient has Insurance Buffer entries ***"
32 K DGSTAT
33 Q
34 ;
35HDR ; -- print standard header
36 D HDR1("=",IOM-$S($G(DGDTIN):1,1:4))
37 Q
38 ;
39HDR1(CHAR,LENG) ; -- print header, specify character
40 N OFF
41 S OFF=$S($G(DGDTIN):0,1:2)
42 W !?(1+OFF),"Insurance",?(13+OFF),"COB",?(17+OFF),"Subscriber ID",?(35+OFF),"Group",?(47+OFF),"Holder",?(55+OFF),"Effect"_$S('OFF:"",1:"i")_"ve",?(65+OFF+$S('OFF:0,1:1)),"Expires" W:'OFF ?75,"Only"
43 I $G(CHAR)'="",LENG S X="",$P(X,CHAR,LENG)="" W !?(1+OFF),X
44 Q
45 ;
46D1(DGVAL) ;
47 N DGX,DGY,DGZ,CAT,OFF
48 ;
49 Q:'$D(DGINS)
50 S OFF=$S($G(DGDTIN):0,1:2)
51 W !?(1+OFF),$S($D(DGINS(DGVAL,1)):$E($P(DGINS(DGVAL,1),U,2),1,10),1:"UNKNOWN")
52 S X=+DGINS(DGVAL,7) I X'="" S X=$S(X=1:"p",X=2:"s",X=3:"t",1:"")
53 W ?(14+OFF),X
54 W ?(17+OFF),$E(DGINS(DGVAL,14),1,16)
55 W ?(35+OFF),$E(DGINS(DGVAL,18),1,10)
56 S DGX=$P(DGINS(DGVAL,12),U,1)
57 W ?(47+OFF),$S(DGX="P":"SELF",DGX="S":"SPOUSE",1:"OTHER")
58 W ?(55+OFF),$TR($$FMTE^XLFDT(DGINS(DGVAL,10),"2DF")," ","0"),?(65+OFF+$S(OFF:1,1:0)),$TR($$FMTE^XLFDT(DGINS(DGVAL,11),"2DF")," ","0")
59 I 'OFF D
60 .I $P(DGINS(DGVAL,9),U,2)="NO" W ?75,"*WNR*" Q
61 Q
Note: See TracBrowser for help on using the repository browser.