Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBJDF11

IBJDF11.m

Go to the documentation of this file.
  1. IBJDF11 ;ALB/CPM - THIRD PARTY FOLLOW-UP REPORT (COMPILE) ;09-JAN-97
  1. ;;2.0;INTEGRATED BILLING;**69,80,118,128,204,205,227,451,530,554,568,618,663,739**;21-MAR-94;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. DQ ; - Tasked entry point.
  1. K ^TMP("IBJDF1",$J) S IBQ=0
  1. ;
  1. ; - Collect divisions when running the job for all divisions.
  1. I IBSD,VAUTD S J=0 F S J=$O(^DG(40.8,J)) Q:'J S VAUTD(J)=""
  1. ;
  1. ; - Find data required for the report.
  1. S IBA=0 F S IBA=$O(^PRCA(430,"AC",16,IBA)) Q:'IBA D Q:IBQ
  1. .;
  1. .I IBA#100=0 S IBQ=$$STOP^IBOUTL("Third Party Follow-Up Report") Q:IBQ
  1. .;
  1. .;**IB*2.0*618 - Moved ahead of RI Bill check to ensure
  1. .; claim exists before checking rate types
  1. .; on Community Care Categories.
  1. .I '$D(^DGCR(399,IBA,0)) Q ; No corresponding claim to this AR.
  1. .;
  1. .S IBAR=$G(^PRCA(430,IBA,0))
  1. .;
  1. .;**IB*2.0*618 - Change add new AR Categories and AR Category/
  1. .; Rate Types
  1. .S IBARNUM=$$GET1^DIQ(430.2,$P(IBAR,U,2)_",",6) ; Get AR Cat Num
  1. .Q:'$$CHKARNUM(IBARNUM) ;Confirm RI Bill, quit if not
  1. .;
  1. .; - Determine whether bill is inpatient, outpatient, or RX refill.
  1. .S IBTYP=$P($G(^DGCR(399,IBA,0)),U,5),IBTYP=$S(IBTYP>2:2,1:1)
  1. .S:$D(^IBA(362.4,"C",IBA)) IBTYP=3
  1. .I $P(IBAR,U,2)=45 S IBTYP=4 ;IB*2*554/DRF Look for Non-VA
  1. .I $P(IBAR,U,2)>47,($P(IBAR,U,2)<52) S IBTYP=4 ;IB*2.0*6 - Community Care third party
  1. .I IBSEL'[IBTYP,IBSEL'[5 Q
  1. .;
  1. .; - Check the receivable age, if necessary.
  1. .I IBSMN S:"Aa"[IBSDATE IBARD=$$ACT^IBJDF2(IBA) S:"Dd"[IBSDATE IBARD=$$DATE1^IBJDF2(IBA) Q:'IBARD S:IBARD IBARD=$$FMDIFF^XLFDT(DT,IBARD) I IBARD<IBSMN!(IBARD>IBSMX) Q
  1. .;
  1. .; - Check the minimum dollar amount, if necessary.
  1. .S IBWBA=+$G(^PRCA(430,IBA,7)) I IBSAM,IBWBA<IBSAM Q
  1. .;
  1. .; - Get division, if necessary.
  1. .I 'IBSD S IBDIV=0
  1. .E S IBDIV=$$DIV^IBJDF2(IBA) I 'IBDIV S IBDIV=+$$PRIM^VASITE()
  1. .I IBSD,'VAUTD Q:'$D(VAUTD(IBDIV)) ; Not a selected division.
  1. .;
  1. .; - Exclude receivables referred to Regional Counsel, if necessary.
  1. .S IBWRC=$G(^PRCA(430,IBA,6)) I 'IBSRC,$P(IBWRC,U,4) Q
  1. .S IBWRC=$S('$P(IBWRC,U,4):"",$P(IBWRC,U,22):$P(IBWRC,U,22),1:$P(IBWRC,U,4))
  1. .;
  1. .; - Get the insurance carrier and exclude claim, if necessary.
  1. .S IBWIN=$$INS(IBA) I IBWIN="" Q
  1. .;
  1. .; - Get the claim patient and exclude claim, if necessary.
  1. .S IBWPT=$$PAT(IBA) I IBWPT="" Q
  1. .;
  1. .; - Get remaining claim information.
  1. .; IB*2.0*451 - get 1st/3rd party payment EEOB indicator for bill
  1. .S IBPFLAG=$$EEOB^IBOA31(IBA)
  1. .S IBWDP=$P(IBAR,U,10)
  1. .;IB*2.0*530 Add indicator for rejects - External Bill # (.01) value is passed in, not IEN
  1. .S IBWBN=$G(IBPFLAG)_$S(+$$BILLREJ^IBJTU6($P($G(^DGCR(399,IBA,0)),U)):"c",1:"")_$P(IBAR,U) ; flag bill # when applicable
  1. .S IBBU=$G(^DGCR(399,IBA,"U")),IBWFR=+IBBU,IBWTO=$P(IBBU,U,2)
  1. .S IBWSC=$$OTH($P(IBWPT,U,5),$P(IBWIN,"@@",2),IBWFR),IBWOR=$P(IBAR,U,3)
  1. .S IBWSI=$P($G(^DPT(+$P(IBWPT,U,5),.312,+$P($G(^DGCR(399,IBA,"MP")),U,2),0)),U,2)
  1. .;
  1. .; - Set up main report index.
  1. .F X=IBTYP,5 I IBSEL[X D
  1. ..S ^TMP("IBJDF1",$J,IBDIV,X,IBWIN,$P(IBWPT,U)_"@@"_$P(IBWPT,U,5),IBWDP_"@@"_IBWBN)=$P(IBWPT,U,2)_" ("_$P(IBWPT,U,4)_")"_U_$P(IBWPT,U,3)_U_IBWSC_U_IBWFR_U_IBWTO_U_IBWOR_U_IBWBA_"~"_IBWRC_U_IBWSI
  1. .;
  1. .; - Add bill comment history, if necessary.
  1. .I IBSH D
  1. ..S X=0 F S X=$O(^PRCA(433,"C",IBA,X)) Q:'X D
  1. ...S Y=$G(^PRCA(433,X,1))
  1. ...I $P(Y,U,2)'=35,$P(Y,U,2)'=45 Q ; Not a decrease/comment transact.
  1. ...S DAT=$S(Y:+Y\1,1:+$P(Y,U,9)\1)
  1. ...;
  1. ...; - Append brief and transaction comments.
  1. ...K COM,COM1 S COM(0)=DAT,X1=0
  1. ...S COM1(1)=$P($G(^PRCA(433,X,5)),U,2),COM1(2)=$E($P($G(^(8)),U,6),1,70)
  1. ...S COM(1)=COM1(1)_$S(COM1(1)]""&(COM1(2)]""):"|",1:"")_COM1(2)
  1. ...I COM(1)]"" S COM(1)="**"_COM(1)_"**",X1=1
  1. ...;
  1. ...; - Get main comments.
  1. ...S X2=0 F S X2=$O(^PRCA(433,X,7,X2)) Q:'X2 S COM($S(X1:X2+1,1:X2))=^(X2,0)
  1. ...;
  1. ...S X1="" F S X1=$O(COM(X1)) Q:X1="" F X2=IBTYP,4 I IBSEL[X2 D
  1. ....S ^TMP("IBJDF1",$J,IBDIV,X2,IBWIN,$P(IBWPT,U)_"@@"_$P(IBWPT,U,5),IBWDP_"@@"_IBWBN,X,X1)=COM(X1)
  1. ;
  1. I 'IBQ D EN^IBJDF12 ; Print the report.
  1. ;
  1. CHKARNUM(IBCAT) ; Check for Reimbursable insurance
  1. ;
  1. Q:IBCAT=21 1 ;Reimbursable Insurance - Third Party
  1. ;
  1. ;All Non VA care AR Categories, Emergency/Humanitarian, and Ineligible Hospital
  1. I (IBCAT>46),(IBCAT<54) Q 1 ;Fee Reimbursable Insurance - Third Party
  1. Q 0
  1. ;
  1. ENQ K ^TMP("IBJDF1",$J)
  1. I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
  1. ;
  1. D ^%ZISC
  1. ENQ1 K IBA,IBAR,IBARD,IBBU,IBDIV,IBQ,IBIO,IBWRC,IBWPT,IBWDP,IBWIN,IBWBN
  1. K IBTYP,IBWSC,IBWSI,IBWFR,IBWTO,IBWOR,IBWBA,COM,COM1,DAT,VAUTD,IBARNUM
  1. K X,X1,X2,Y,Z
  1. Q
  1. ;
  1. INS(X) ; - Find the Insurance company and decide to include the claim.
  1. ; Input: X=Pointer to the claim/AR in file #399/#430
  1. ; plus all variable input in IBS*
  1. ; Output: Y=Insurance Company name and pointer to file #36
  1. ;
  1. N Y,Z,Z1 S Y=""
  1. I '$G(X) G INSQ
  1. S Z=+$G(^DGCR(399,X,"MP")),Z1=$P($G(^DIC(36,Z,0)),U)
  1. I $G(IBSI) G INSQ:'$D(IBSI(Z)),INSC
  1. I IBSIF'="@",'Z G INSQ
  1. I $D(IBSIA) G:IBSIA="ALL"&('Z) INSQ G:IBSIA="NULL"&(Z) INSQ
  1. I Z1="" S Z1="UNKNOWN" G INSC
  1. I $G(IBSIA)="ALL" G INSC
  1. I IBSIF="@",IBSIL="zzzzz" G INSC
  1. I IBSIF]Z1!(Z1]IBSIL) G INSQ
  1. ;
  1. INSC S Y=Z1_"@@"_Z
  1. INSQ Q Y
  1. ;
  1. PAT(X) ; - Find the claim patient and decide to include the claim.
  1. ; Input: X=Pointer to the claim/AR in file #399/#430
  1. ; plus all variable input in IBS*
  1. ; Output: Y=1^2^3^4^5, where
  1. ; 1 => sort key (name or last four)
  1. ; 2 => patient name
  1. ; 3 => patient ssn
  1. ; 4 => patient age
  1. ; 5 => patient pointer to file #2
  1. ;
  1. N AGE,DFN,DOB,KEY,Y,Z S Y=""
  1. I '$G(X) G PATQ
  1. S DFN=+$P($G(^DGCR(399,X,0)),U,2),Z=$G(^DPT(DFN,0))
  1. S KEY=$S(IBSN="N":$P(Z,U),1:$E($P(Z,U,9),6,9))
  1. ;
  1. I IBSNF'="@",'DFN G PATQ
  1. I $D(IBSNA) G:IBSNA="ALL"&('DFN) PATQ G:IBSNA="NULL"&(DFN) PATQ
  1. I KEY="" S Y="UNK^UNK^UNK^UNK^UNK" G PATQ
  1. I $G(IBSNA)="ALL" G PATC
  1. I IBSNF="@",IBSNL="zzzzz" G PATC
  1. I IBSNF]KEY!(KEY]IBSNL) G PATQ
  1. ;
  1. PATC ; - Find all patient data.
  1. S DOB=$P(Z,U,3)
  1. S AGE=$S('DOB:"UNK",1:$E(DT,1,3)-$E(DOB,1,3)-($E(DT,4,7)<$E(DOB,4,7)))
  1. S Y=KEY_U_$E($P(Z,U),1,17)_U_$P(Z,U,9)_U_AGE_U_DFN
  1. PATQ Q Y
  1. ;
  1. OTH(DFN,INS,DS) ; - Find a patient's other valid insurance carrier (if any).
  1. ; Input: DFN=Pointer to the patient in file #2
  1. ; INS=Pointer to the patient's primary carrier in file #36
  1. ; DS=Date of service for validity check
  1. ; Output: Valid insurance carrier (1st 13 chars.) or null
  1. ;
  1. N Y S Y="" I '$G(DFN)!('$G(DS)) G OTHQ
  1. S Z=0 F S Z=$O(^DPT(DFN,.312,Z)) Q:'Z S X=$G(^(Z,0)) D:X Q:Y]""
  1. .I $G(INS),+X=INS Q
  1. .S X1=$G(^DIC(36,+X,0)) I X1="" Q
  1. .I $P(X1,U,2)'="N",$$CHK^IBCNS1(X,DS) S Y=$E($P(X1,U),1,13)
  1. ;
  1. OTHQ Q Y