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

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1IBCNBLP1 ;ALB/ARH-Ins Buffer: LM buffer process build ;1 Jun 97
2 ;;2.0;INTEGRATED BILLING;**82,133**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6PATLST(IBCNT,DFN,CMPDATA) ; collect and display all the patients insurance policies
7 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
8 N IBINS,IBY,IBX,IB0,IBG0,IBI0,IBLINE,IBPLDA,IBBOLD,IBFND,IBDA S IBFND=0,IBCNT=+$G(IBCNT)
9 ;
10 D ALL^IBCNS1(DFN,"IBINS")
11 ;
12 S IBY=$J("",26)_"Patient's Existing Insurance" D SET(IBY,1,"","R")
13 S IBY=" Insurance Company Group # Subscriber Id Holder Effective Expires" D SET(IBY,1,"","U")
14 ;
15 S IBPLDA=0 F S IBPLDA=$O(IBINS(IBPLDA)) Q:'IBPLDA D
16 . S IB0=IBINS(IBPLDA,0),IBG0=$G(^IBA(355.3,+$P(IB0,U,18),0)),IBI0=$G(^DIC(36,+IB0,0)),IBCNT=IBCNT+1,IBFND=1
17 . S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,3)
18 . S IBY=$S(+$P(IBI0,U,5):"~",+$P(IBG0,U,11):"~",'$P(IBG0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,4,1)
19 . S IBY=$P(IBI0,U,1) S IBLINE=$$SETSTR(IBY,IBLINE,5,18,$P(CMPDATA,U,1))
20 . S IBY=$P(IBG0,U,4) S IBLINE=$$SETSTR(IBY,IBLINE,25,13,$P(CMPDATA,U,2))
21 . S IBY=$P(IB0,U,2) S IBLINE=$$SETSTR(IBY,IBLINE,40,13,$P(CMPDATA,U,3))
22 . S IBY=$P(IB0,U,16),IBY=$$EXPAND^IBTRE(355.33,60.06,IBY) S IBLINE=$$SETSTR(IBY,IBLINE,55,6)
23 . S IBY=$$DATE($P(IB0,U,8)) S IBLINE=$$SETSTR(IBY,IBLINE,63,8)
24 . S IBY=$$DATE($P(IB0,U,4)) S IBLINE=$$SETSTR(IBY,IBLINE,73,8)
25 . S IBDA=+IB0_U_+$P(IB0,U,18)_U_IBPLDA_U_+DFN
26 . D SET(IBLINE,IBCNT,IBDA)
27 ;
28 I 'IBFND D SET("",1),SET(" No Insurance Policies on file for this patient.",1),SET("",1)
29 Q
30 ;
31GRPLST(IBCNT,IBINSDA,DFN,CMPDATA) ; display insurance group/plans for a specific company
32 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
33 ; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
34 N IBX,IBY,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA S IBFND=0,IBCNT=+$G(IBCNT),IBI0=$G(^DIC(36,IBINSDA,0))
35 ;
36 S IBX="Existing Plans for "_$P(IBI0,U,1)_" ("_$P($G(^DIC(36,IBINSDA,.11)),U,1)_")"
37 S IBY=$J("",40-($L(IBX)\2))_IBX D SET(IBY,1,"","R")
38 S IBY=" Group Name Group # Type of Plan" D SET(IBY,1,"","U")
39 ;
40 S IBGRPDA=0 F S IBGRPDA=$O(^IBA(355.3,"B",IBINSDA,IBGRPDA)) Q:'IBGRPDA D
41 . S IB0=$G(^IBA(355.3,IBGRPDA,0)) I +$G(DFN),$P(IB0,U,2)=0,$P(IB0,U,10)'=DFN Q
42 . S IBCNT=IBCNT+1,IBFND=1,IBPOLDA=$$PTGRP^IBCNBU1(DFN,IBINSDA,IBGRPDA)
43 . S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,4,$S(+IBPOLDA:IBY,1:""))
44 . S IBY=$S(+$P(IBI0,U,5):"~",+$P(IB0,U,11):"~",'$P(IB0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,5,1)
45 . S IBY=$P(IB0,U,3) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,6,20,$P(CMPDATA,U,1))
46 . S IBY=$P(IB0,U,4) S IBLINE=$$SETSTR(IBY,IBLINE,30,17,$P(CMPDATA,U,2))
47 . S IBY=$P(IB0,U,9) I +IBY S IBY=$P($G(^IBE(355.1,+IBY,0)),U,1) S IBLINE=$$SETSTR(IBY,IBLINE,50,30,$P(CMPDATA,U,3))
48 . S IBDA=+IB0_U_+IBGRPDA_U_+IBPOLDA_U_DFN
49 . D SET(IBLINE,IBCNT,IBDA)
50 ;
51 I 'IBFND D SET("",1),SET(" No Insurance Group/Plans on file for this Insurance Company.",1),SET("",1)
52 Q
53 ;
54SRCHLST(IBCNT,DFN,INSNM,GRPNM,GRPNUM) ; display any insurance group/plan that matchs either group name or group number
55 ; if the buffer field data (CMPDATA) matches the displayed insurance entry's data, then that data is displayed in bold
56 ; if the buffer entry's patient is already a member of the group/plan then the record's number is displayed in bold
57 ;
58 N IBX,IBY,IBCX,IBFDATA,IBGRPDA,IBPOLDA,IB0,IBI0,IBLINE,IBBOLD,IBFND,IBDA,IBFD,IBLNS
59 S IBFND=0,IBCNT=+$G(IBCNT),IBLNS=$S(+IBCNT:IBCNT,1:1) K ^TMP($J,"IBCNBLPG")
60 ;
61 S IBY=$J(" ",80) D SET(IBY,IBLNS)
62 S IBX="Any Group/Plan that may match Group Name or Group Number",IBY=$J("",40-($L(IBX)\2))_IBX D SET(IBY,IBLNS,"","R")
63 S IBY=" Insurance Company Group Name Group Number" D SET(IBY,IBLNS,"","U")
64 ;
65 F IBCX="D","E" S IBFDATA=$S(IBCX="D":$G(GRPNM),1:$G(GRPNUM)) I IBFDATA'="" D
66 . S IBFD=$$PREV(IBFDATA) F S IBFD=$O(^IBA(355.3,IBCX,IBFD)) Q:IBFD=""!(IBFD'[IBFDATA) D
67 .. S IBGRPDA=0 F S IBGRPDA=$O(^IBA(355.3,IBCX,IBFD,IBGRPDA)) Q:IBGRPDA="" D
68 ... Q:$D(^TMP($J,"IBCNBLPG",IBGRPDA)) S ^TMP($J,"IBCNBLPG",IBGRPDA)=""
69 ... S IB0=$G(^IBA(355.3,IBGRPDA,0)) I +$G(DFN),$P(IB0,U,2)=0,$P(IB0,U,10)'=DFN Q
70 ... S IBCNT=IBCNT+1,IBFND=1,IBPOLDA=+$$PTGRP^IBCNBU1(DFN,+IB0,IBGRPDA),IBI0=$G(^DIC(36,+IB0,0))
71 ... S IBY=IBCNT S IBLINE=$$SETSTR(IBY,"",1,4,$S(IBPOLDA:IBY,1:""))
72 ... S IBY=$S(+$P(IBI0,U,5):"~",+$P(IB0,U,11):"~",'$P(IB0,U,2):"-",1:"") S IBLINE=$$SETSTR(IBY,IBLINE,5,1)
73 ... S IBY=$P(IBI0,U,1) S IBLINE=$$SETSTR(IBY,IBLINE,6,18,$G(INSNM))
74 ... S IBY=$P($G(^DIC(36,+IB0,.11)),U,1) S IBLINE=$$SETSTR(IBY,IBLINE,26,13)
75 ... S IBY=$P(IB0,U,3) S:IBY=""&('$P(IB0,U,2)) IBY="<individual policy>" S IBLINE=$$SETSTR(IBY,IBLINE,41,20,$G(GRPNM))
76 ... S IBY=$P(IB0,U,4) S IBLINE=$$SETSTR(IBY,IBLINE,63,17,$G(GRPNUM))
77 ... S IBDA=+IB0_U_IBGRPDA_U_+IBPOLDA_U_DFN
78 ... D SET(IBLINE,IBCNT,IBDA)
79 ;
80 I 'IBFND D SET("",IBCNT),SET(" No Group/Plans found that Match the buffer entry's Group Name or Group Number.",IBCNT),SET("",IBCNT)
81 K ^TMP($J,"IBCNBLPG")
82 Q
83 ;
84SETSTR(DATA,LINE,COL,LNG,CMPDATA) ; save data in formated line, if data matchs compare data save string position for bolding
85 S LINE=$$SETSTR^VALM1(DATA,LINE,COL,LNG)
86 I $D(CMPDATA),DATA=CMPDATA S IBBOLD=$G(IBBOLD)_COL_";"_LNG_"^"
87 I $D(CMPDATA),DATA'=CMPDATA,$E(DATA,1,$L(CMPDATA))[CMPDATA S IBBOLD=$G(IBBOLD)_COL_";"_$L(CMPDATA)_"^"
88 Q LINE
89 ;
90SET(LINE,CNT,IBDA,SPEC) ;
91 S VALMCNT=VALMCNT+1 N IBX,IBI
92 S ^TMP("IBCNBLP",$J,VALMCNT,0)=LINE
93 I +$G(CNT) S ^TMP("IBCNBLP",$J,"IDX",VALMCNT,+CNT)=""
94 I +$G(CNT),+$G(IBDA) S ^TMP("IBCNBLPX",$J,+CNT)=VALMCNT_U_IBDA
95 I $G(SPEC)="U" D CNTRL^VALM10(VALMCNT,1,80,IOUON,IOUOFF)
96 I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
97 I $G(SPEC)="R" D CNTRL^VALM10(VALMCNT,1,80,IORVON,IORVOFF)
98 I $D(IBBOLD) F IBI=1:1 S IBX=$P(IBBOLD,U,IBI) Q:IBX="" D
99 . D CNTRL^VALM10(VALMCNT,$P(IBX,";",1),$P(IBX,";",2),IOINHI,IOINORM)
100 K IBBOLD
101 Q
102 ;
103DATE(X) ;
104 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
105 Q Y
106 ;
107PREV(STRING) ; return previous ascii value of the string for collating
108 N IBL,IBX S IBL=$L(STRING),IBX=$E(STRING,1,IBL-1)_$C($A($E(STRING,IBL))-1)_"~"
109 Q IBX
Note: See TracBrowser for help on using the repository browser.