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

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1IBCNBLP ;ALB/ARH-Ins Buffer: LM buffer process screen ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; - main entry point for screen
6 D EN^VALM("IBCNB INSURANCE BUFFER PROCESS")
7 Q
8 ;
9HDR ; header code for list manager display
10 N IBX,IB0,IBY,VADM,VA,VAERR S IBX=""
11 I +DFN D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
12 S VALMHDR(1)=IBX
13 S VALMHDR(2)=" "
14 S IB0=$G(^IBA(355.33,IBBUFDA,21))
15 S IBY=$E($P(IB0,U,4),1,13),IBX=$P($G(^DIC(5,+$P(IB0,U,5),0)),U,2),IBY=IBY_$S(IBY'=""&(IBX'=""):", ",1:"")_IBX
16 S IBY=$E($P(IB0,U,1),1,20)_$S(IBY'="":", ",1:"")_IBY,IBY=$S(IBY'="":" ("_IBY_")",1:"")
17 S IBX=$E($P($G(^IBA(355.33,IBBUFDA,20)),U,1),1,18)_IBY,IBX=$J("",40-($L(IBX)\2))_IBX
18 S VALMHDR(3)=IBX
19 I +$G(IBCNSCRN) D GRPHDR(IBBUFDA) Q
20 D PATHDR(IBBUFDA)
21 Q
22 ;
23INIT ; initialization for list manager list, ifn of record to display required IBBUFDA
24 K ^TMP("IBCNBLP",$J),^TMP("IBCNBLPX",$J) N IBINSDA
25 I '$G(IBBUFDA) S VALMQUIT="" Q
26 S IBINSDA=+$G(IBCNSCRN)
27 S DFN=+$G(^IBA(355.33,IBBUFDA,60))
28 D BLD
29 Q
30 ;
31HELP ; list manager help
32 D FULL^VALM1
33 W !!,"This screen displays a summary of the chosen Buffer entry in the header."
34 W !!,"The list portion of the screen may display either:"
35 W !,?5,"1) a list of all of the patient's current and past insurance policies,"
36 W !,?8,"followed by a list of any Group/Plan that has a Group Name or ",!,?8,"Group Number that may match the Buffer entry's."
37 W !,?5,"2) a list of all of the Group/Plans for a user specified insurance company."
38 W !!,"Use the 'Insurance Co/Patient' action to toggle between these two screens."
39 W !!,"Flags: '~' company/group is inactive '-' individual patient policy"
40 W !!,"Bold Data: If one of the following Buffer File entry data elements matches all",!,"or the first part of the "
41 W "corresponding data element of the policy or group/plan",!,"being displayed then the matching part of the data element will be displayed in",!,"bold characters:"
42 W !," Subscriber Id, Insurance Company Name, Group Number, Group Name, Type of Plan"
43 W !!,"Bold Number: On the Group/Plan lists, the number preceding the group/plan being",!,"displayed will be in bold if the patient is already a member of that plan."
44 W !!,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry."
45 D PAUSE^VALM1 S VALMBCK="R"
46 Q
47 ;
48EXIT ; exit list manager option and clean up
49 K ^TMP("IBCNBLP",$J),^TMP("IBCNBLPX",$J),DFN,IBCNSCRN
50 D CLEAR^VALM1
51 Q
52 ;
53BLD ; build screen display
54 ;
55 N PATCMP,GRPCMP,CNT S VALMCNT=0,CNT=0
56 ;
57 S PATCMP=$$PATDATA(IBBUFDA),GRPCMP=$$GRPDATA(IBBUFDA)
58 ;
59 I +$G(IBCNSCRN) D GRPLST^IBCNBLP1(.CNT,IBINSDA,DFN,GRPCMP) Q
60 ;
61 D PATLST^IBCNBLP1(.CNT,DFN,PATCMP)
62 D SRCHLST^IBCNBLP1(.CNT,DFN,$P(PATCMP,U,1),$P(GRPCMP,U,1),$P(GRPCMP,U,2))
63 Q
64 ;
65DATE(X) ;
66 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
67 Q Y
68 ;
69 ;
70PATHDR(IBBUFDA) ; additional header lines: display buffer entry for display of existing patient's insurance screen
71 Q:'IBBUFDA N IBX,IBY,IB20,IB40,IB60 S IBX=""
72 S IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40)),IB60=$G(^IBA(355.33,IBBUFDA,60))
73 ;
74 S IBX="" I 'IB40 S IBY="-" S IBX=$$SETSTR^VALM1(IBY,IBX,4,1)
75 S IBY=$P(IB20,U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,5,18)
76 S IBY=$P(IB40,U,3) S IBX=$$SETSTR^VALM1(IBY,IBX,25,13)
77 S IBY=$P(IB60,U,4) S IBX=$$SETSTR^VALM1(IBY,IBX,40,13)
78 S IBY=$P(IB60,U,6),IBY=$$EXPAND^IBTRE(355.33,60.06,IBY) S IBX=$$SETSTR^VALM1(IBY,IBX,55,6)
79 S IBY=$$DATE($P(IB60,U,2)) S IBX=$$SETSTR^VALM1(IBY,IBX,63,8)
80 S IBY=$$DATE($P(IB60,U,3)) S IBX=$$SETSTR^VALM1(IBY,IBX,73,8)
81 S VALMHDR(4)=IBX
82 Q
83 ;
84GRPHDR(IBBUFDA) ; additional header lines: display buffer entry for display of other insurance group plans screen
85 Q:'IBBUFDA N IBX,IBY,IB40 S IBX=""
86 S IB40=$G(^IBA(355.33,IBBUFDA,40))
87 ;
88 S IBX="" I 'IB40 S IBY="-" S IBX=$$SETSTR^VALM1(IBY,IBX,5,1)
89 S IBY=$P(IB40,U,2) S IBX=$$SETSTR^VALM1(IBY,IBX,6,20)
90 S IBY=$P(IB40,U,3) S IBX=$$SETSTR^VALM1(IBY,IBX,30,17)
91 S IBY=$P(IB40,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBX=$$SETSTR^VALM1(IBY,IBX,50,30)
92 S VALMHDR(4)=IBX
93 Q
94 ;
95PATDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
96 ; for the patient insurance list compare: INS COMPANY NAME ^ GROUP NUMBER ^ SUBSCRIBER ID
97 N IBX S IBX=$P($G(^IBA(355.33,IBBUFDA,20)),U,1)_U_$P($G(^IBA(355.33,IBBUFDA,40)),U,3)_U_$P($G(^IBA(355.33,IBBUFDA,60)),U,4)
98 Q IBX
99 ;
100GRPDATA(IBBUFDA) ; create string of data from buffer entry to compare with data in existing insurance entries
101 ; for the group plan list compare: GROUP NAME ^ GROUP NUMBER ^ TYPE OF PLAN
102 N IBX,IBY S IBY=$G(^IBA(355.33,IBBUFDA,40)) S IBX=$P(IBY,U,2)_U_$P(IBY,U,3)_U_$P($G(^IBE(355.1,+$P(IBY,U,9),0)),U,1)
103 Q IBX
Note: See TracBrowser for help on using the repository browser.