| 1 | IBCOMC1 ;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 | ;
|
|---|
| 5 | BEG ; 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 | ;
|
|---|
| 62 | QUEQ ; 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 | ;
|
|---|
| 66 | SET ; 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)
|
|---|
| 84 | SETQ Q
|
|---|
| 85 | ;
|
|---|
| 86 | DLT ; 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
|
|---|
| 99 | DLTQ Q
|
|---|
| 100 | ;IBCOMC1
|
|---|
