source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCOMC1.m@ 1791

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1IBCOMC1 ;ALB/CMS-IDENTIFY PT BY AGE WITH OR WITHOUT INSURANCE (CON'T);10-09-98
2 ;;2.0;INTEGRATED BILLING;**103,183**;21-MAR-94
3 Q
4 ;
5BEG ; Entry to run Identify Patients with/without Insurance Report
6 ; Input variables must exist:
7 ; IBAIB - Required. How to sort
8 ; 1= Patient Name Range 2= Termianl Digit Range
9 ; IBRF - Required. Name or Terminal Digit Range Start value
10 ; IBRL - Required. Name or Terminal Digit Range Go to value
11 ; IBAGEF - Optional. Age start value or null
12 ; IBAGEL - Optional. Age end value or null
13 ; IBBDT - Required. Last Treated Start Date
14 ; IBEDT - Required. Last Treated End Date
15 ;
16 ; IBSIN - Required. Include Insurance Company search
17 ; 1=Insurance Co. Range 2=Selected Ins. Co. 3=No Ins. Co.
18 ; If IBSIN=2 then the $O(IBSIN(1-6))=selected companies
19 ; IBSINF - Optional. Ins. Co. start Range or null
20 ; IBSINL - Optional. Ins. Co. end Range or null
21 ;
22 N DFN,IBC,IBC0,IBDLT,IBGP,IBI,IBINS,IBINSV,IBPAGE,IBQUIT
23 N IBTMP,IBTD,IBX,IBXX,SDCNT,VA,VADM,VAERR,VAPA,X,Y
24 K ^TMP("IBCOMC",$J) S IBPAGE=0,IBQUIT=0,IBINSV=""
25 ;
26 ; Date Last Treated entered get DFN's
27 D DLT
28 ;
29 S DFN=0 F S DFN=$O(^TMP("IBCOMC",$J,"DLT",DFN)) Q:'DFN D
30 .;
31 .K IBINS S (IBTD,IBINSV,IBINS)=""
32 .; I Terminal Digit out of range quit
33 .I IBAIB=2 S IBTD=$$TERMDG^IBCONS2(DFN) I (+IBTD>IBRL)!(IBRF>+IBTD) Q
34 .K VA,VADM,VAERR,VAPA
35 .D DEM^VADPT,ADD^VADPT
36 .;
37 .; I Pt. name out of range quit
38 .S VADM(1)=$P($G(VADM(1)),U,1) I VADM(1)="" Q
39 .I IBAIB=1,VADM(1)]IBRL Q
40 .I IBAIB=1,IBRF]VADM(1) Q
41 .;
42 .; I Age out of range quit
43 .I IBAGEF I (+VADM(4)<IBAGEF)!(+VADM(4)>IBAGEL) Q
44 .;
45 .; Check Insurance
46 .S IBINSV=$G(^IBA(354,+DFN,60)) I IBSIN'=3,+IBINSV Q
47 .I IBSIN=3,IBINSV D SET Q
48 .;
49 .D ALL^IBCNS1(DFN,"IBINS",3)
50 .I IBSIN=3,$G(IBINS(0)) Q
51 .I IBSIN=3,'$G(IBINS(0)) D SET Q
52 .;
53 .S IBX=0 F S IBX=$O(IBINS(IBX)) Q:'IBX D
54 ..S IBC=IBINS(IBX,0)
55 ..S IBC0=$G(^DIC(36,+IBC,0))
56 ..I IBSIN=1,$P(IBC0,U,1)]IBSINF,IBSINL]$P(IBC0,U,1) D SET Q
57 ..I IBSIN=2 F IBXX=1:1:6 I $G(IBSIN(IBXX)),+IBC=+IBSIN(IBXX) D SET
58 .;
59 I '$O(^TMP("IBCOMC",$J,0)) D HD^IBCOMC2 W !!,"** NO RECORDS FOUND **" G QUEQ
60 D HD^IBCOMC2,WRT^IBCOMC2
61 ;
62QUEQ ; Exit clean-UP
63 W ! D ^%ZISC K IBTMP,IBAIB,IBRF,IBRL,IBSIN,IBAGEF,IBAGEL,IBBDT,IBEDT,IBSINF,IBSINL,VA,VAERR,VADM,VAPA,^TMP("IBCOMC",$J)
64 Q
65 ;
66SET ; set data line for global
67 ;S IBTMP(1)=PT NAME^SSN^AGE^DOB^CAT^DATE LAST VISIT
68 ;S IBTMP(2)=INSURANCE NAME^REIMBURSE?^GROUP NAME
69 ; or Date Verified No Insurance on File and Patient Home Phone
70 ;
71 N IBTD,IBCAT
72 S IBTD(+$G(^TMP("IBCOMC",$J,"DLT",DFN,"INP")))="Inp "
73 S IBTD(+$G(^TMP("IBCOMC",$J,"DLT",DFN,"OUT")))="Out "
74 S IBTD=$O(IBTD(""),-1) S IBTD=IBTD_U_IBTD(IBTD)
75 S IBCAT=$P($$LST^DGMTU(DFN),U,4) S IBCAT=$S(IBCAT="C":"Yes",IBCAT="G":"GMT",1:"No")
76 S IBTMP(1)=$S(+VADM(6):"*",1:"")_VADM(1)_U_"("_$E(VADM(1),1,1)_$P($P(VADM(2),U,2),"-",3)_")"_U_+VADM(4)_U_$P(VADM(3),U,2)_U_IBCAT_U_$P(IBTD,U,2)_$$FMTE^XLFDT(+IBTD,"5ZD")
77 I IBSIN=3 S IBTMP(2)=$S(+IBINSV:"No Coverage Verified: "_$$FMTE^XLFDT(+IBINSV,"5ZD"),1:"No Insurance on File.")_" Patient's Home Phone: "_$P(VAPA(8),U,1)
78 I IBSIN'=3 S IBTMP(2)=$P(IBC0,U,1)_U_$P(IBC0,U,2)_U_$S($P($G(IBINS(IBX,355.3)),U,3)]"":$P(IBINS(IBX,355.3),U,3),1:"(No Plan Name)")
79 ;
80 ; Set Global array
81 S ^TMP("IBCOMC",$J,1,$S(IBAIB=2:IBTD,1:VADM(1)),DFN)=IBTMP(1)
82 I IBSIN=3 S IBC=999999999
83 S ^TMP("IBCOMC",$J,1,$S(IBAIB=2:IBTD,1:VADM(1)),DFN,+IBC)=IBTMP(2)
84SETQ Q
85 ;
86DLT ; Get DFN's for Date Last Treated Range
87 N IBCBK,IBDA,IBFIL,IBQUERY,IBVAL,IBX,X,Y K ^TMP("IBCOMC",$J,"DLT")
88 I (IBBDT="")!(IBEDT="") G DLTQ
89 S IBFIL="",IBCBK="I '$P(Y0,U,6),$P(Y0,U,12)=2,$P(Y0,U,7) S ^TMP(""IBCOMC"",$J,""DLT"",Y,""INP"")=+Y0"
90 S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT
91 ;
92 ; get DFNs for date last seen outpatient
93 D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFIL,IBCBK,1,0,"BACKWARD")
94 ;
95 ; get DFNs for date last seen discharge date
96 S IBX=IBBDT F S IBX=$O(^DGPM("ATT3",IBX)) Q:('IBX)!(IBX>IBEDT) D
97 .S IBDA=0 F S IBDA=$O(^DGPM("ATT3",IBX,IBDA)) Q:'IBDA D
98 ..S ^TMP("IBCOMC",$J,"DLT",+$P($G(^DGPM(IBDA,0)),U,3),"OUT")=IBX
99DLTQ Q
100 ;IBCOMC1
Note: See TracBrowser for help on using the repository browser.