Summary Table

Categories Total Count
PII 0
URL 0
DNS 0
EKL 0
IP 0
PORT 0
VsID 0
CF 0
AI 0
VPD 0
PL 0
Other 0

File Content

Cache for Windows^INT^WNS^^~Format=Cache.S~^RAW
%RO on 29 Aug 2018 10:52:44AM
IBJDF61^INT^1^64889,33971.701706^0
IBJDF61 ;ALB/RB - MISC. BILLS FOLLOW-UP REPORT (COMPILE) ;15-APR-00
;;2.0;INTEGRATED BILLING;**123,159,356,618**;21-MAR-94
;;Per VHA Directive 6402, this routine should not be modified.
;
ST ; - Tasked entry point.
K IB,IBCAT,^TMP("IBJDF6P",$J),^TMP("IBJDF6D",$J) S IBQ=0
N IBPDFLG ;Patient (1) or Debtor (0) flag
;
; - Set selected categories for report.
; IB*2.0*618 - Added Community Care Misc. Categories
I IBSEL[",1," S IBCAT(21)=1 ; MEDICARE
I IBSEL[",2," S IBCAT(7)=2 ; NO-FAULT AUTO ACCIDENT
I IBSEL[",3," D ; COMMUNITY CARE NO-FAULT AUTO
. S IBCAT(52)=3
. S IBCAT(55)=3
. S IBCAT(58)=3
I IBSEL[",4," S IBCAT(10)=4 ; TORT FEASOR
I IBSEL[",5," D ; COMMUNITY CARE TORT FEASOR
. S IBCAT(53)=5
. S IBCAT(56)=5
. S IBCAT(59)=5
I IBSEL[6 S IBCAT(6)=6 ; WORKMEN'S COMP
I IBSEL[7 D ; COMMUNITY CARE NO-FAULT AUTO
. S IBCAT(54)=7
. S IBCAT(57)=7
. S IBCAT(60)=7
I IBSEL[8 S IBCAT(16)=8 ; CURRENT EMPLOYEE
I IBSEL[9 S IBCAT(15)=9 ; EX-EMPLOYEE
I IBSEL[10 S IBCAT(13)=10 ; FEDERAL AGENCIES-REFUND
I IBSEL[11 S IBCAT(14)=11 ; FEDERAL AGENCIES-REIMBURSEMENT
I IBSEL[12 S IBCAT(12)=12 ; MILITARY
I IBSEL[13 S IBCAT(20)=13 ; INTERAGENCY
I IBSEL[14 S IBCAT(17)=14 ; VENDOR
;
; Initialize the Summary Information
S IBCAT="" F S IBCAT=$O(IBCAT(IBCAT)) Q:IBCAT="" D
. S IBDIV=0
. I IBSDV,$$CATCHK(IBCAT) D Q ;IB*2.0*618
. . F S IBDIV=$O(VAUTD(IBDIV)) Q:IBDIV="" D INIT^IBJDF63
. D INIT^IBJDF63
;
; - Print the header line for the Excel spreadsheet
I $G(IBEXCEL) D PHDL
;
; - Find data required for the report.
S IBA=0 F S IBA=$O(^PRCA(430,"AC",16,IBA)) Q:'IBA D Q:IBQ
. I IBA#100=0 D Q:IBQ
. . S IBQ=$$STOP^IBOUTL("Miscellaneous Bills Follow-Up Report")
. S IBAR=$G(^PRCA(430,IBA,0)) Q:'IBAR
. S IBCAT=+$P(IBAR,U,2) Q:'$D(IBCAT(IBCAT)) ; Invalid AR category.
. S IBCAT1=IBCAT(IBCAT),IBPDFLG=$$CATCHK(IBCAT)
. I IBPDFLG,'$D(^DGCR(399,IBA,0)) Q ; No claim.
. I IBPDFLG,$P($G(^DGCR(399,IBA,0)),U,13)=7 Q ; Cancelled claim.
. ;
. ; - Get division, if necessary.
. I (IBCAT1>7),(IBCAT1<15) S IBDIV=0 ;IB*2.0*618
. E D
. . I 'IBSDV S IBDIV=0
. . E S IBDIV=$$DIV^IBJDF51(IBA)
. ;
. I IBSDV,IBDIV,'VAUTD Q:'$D(VAUTD(IBDIV)) ; Not a selected division.
. ;
. ; - Get patient or debtor for report.
. I IBRPT="D" S IBPTDB=$$PTDB(IBA) Q:IBPTDB=""
. ;
. ; - Check the receivable age, if necessary.
. I IBRPT="D",IBSMN D I (IBARD)<IBSMN!(IBARD>IBSMX) Q
. . S IBARD=+$$ACT^IBJDF2(IBA) S:IBARD IBARD=$$FMDIFF^XLFDT(DT,IBARD)
. ;
. ; - Check the minimum balance amount, if necessary.
. S IBBA=0 F X=1:1:5 S IBBA=IBBA+$P($G(^PRCA(430,IBA,7)),U,X)
. I IBRPT="D",IBSAM,IBBA<IBSAM Q
. ;
. ; - Get stats for summary
. I '$G(IBEXCEL) D EN^IBJDF63 Q:IBRPT="S"
. ;
. ; - Get remaining AR/claim info and set indexes for detailed report.
. S (IBFR,IBLP,IBOI,IBTO,IBCLM)="",IBIN=0
. S IBBN=$P(IBAR,U),IBOR=$P(IBAR,U,3),IBDP=$P(IBAR,U,10)
. I IBPDFLG D Q:'IBI!('IBCLM) ;IB*2.0*618
. . S IBI=+$G(^DGCR(399,IBA,"MP")) Q:'IBI ; Get primary ins carrier.
. . S IBIN=$P($G(^DIC(36,IBI,0)),U)_"@@"_IBI,DFN=$P($P(IBPTDB,U),"@@",2)
. . S IBDP=$P(IBAR,U,10),IBCLM=$$CLMACT^IBJD(IBA,IBCAT) Q:IBCLM=""
. . S IBR=$S(+IBCLM=1:$G(^IB($P(IBCLM,U,2),0)),+IBCLM=2:$G(^DGCR(399,IBA,"U")),1:IBDP)
. . S IBFR=$P(IBR,U,$S(+IBCLM=1:14,1:1)),IBTO=$P(IBR,U,$S(+IBCLM=1:15,+IBCLM=2:2,1:1))
. . S IBOI=$$OTH(DFN,$P(IBIN,"@@",2),IBFR) ; Get other insurance carrier.
. . I $G(IBEXCEL) Q
. . I '($D(^TMP("IBJDF6P",$J,IBDIV,IBCAT,IBIN,$P(IBPTDB,U)))#10) D
. . . S ^TMP("IBJDF6P",$J,IBDIV,IBCAT,IBIN,$P(IBPTDB,U))=$P(IBPTDB,U,2)_" "_$P(IBPTDB,U,6)_U_$P(IBPTDB,U,3,4)_U_IBOI
. . S ^TMP("IBJDF6P",$J,IBDIV,IBCAT,IBIN,$P(IBPTDB,U),IBBN)=IBDP_U_IBFR_U_IBTO_U_IBOR_U_IBBA
. I 'IBPDFLG D
. . S IBLP=+$P($$PYMT^IBJD1(IBA),U,2)
. . I '($D(^TMP("IBJDF6D",$J,IBDIV,IBCAT,0,$P(IBPTDB,U)))#10) D
. . . S ^TMP("IBJDF6D",$J,IBDIV,IBCAT,0,$P(IBPTDB,U))=$P(IBPTDB,U,2)_" "_$P(IBPTDB,U,6)
. . S ^TMP("IBJDF6D",$J,IBDIV,IBCAT,0,$P(IBPTDB,U),IBBN)=IBDP_U_$P(IBPTDB,U,5)_U_IBOR_U_IBLP_U_IBBA
. ;
. I '$G(IBEXCEL) D:IBSH COM Q
. ;
. ; - Set up and write line for Excel document.
. S IBDIV=$P($G(^DG(40.8,$S('IBDIV:+$$PRIM^VASITE(),1:IBDIV),0)),U)
. S IBEXCEL1=IBDIV_U_$P($G(^PRCA(430.2,IBCAT,0)),U,2)_U_$S(IBIN=0:"",1:$P(IBIN,"@@"))
. S IBEXCEL1=IBEXCEL1_U_$P(IBPTDB,U,2)_U_$S($P(IBPTDB,"^",6)="*":"E",1:"")_U_$TR($P(IBPTDB,U,4),"-")
. S IBEXCEL1=IBEXCEL1_U_$P(IBPTDB,U,3)_U_IBOI_U_IBBN_U_$$DT^IBJD(IBDP,1)
. S IBEXCEL1=IBEXCEL1_U_$$DT^IBJD(IBFR,1)_U_$$DT^IBJD(IBTO,1)_U_IBOR
. S IBEXCEL1=IBEXCEL1_U_IBLP_U_IBBA_U
. I IBSH D COM ; This will capture the Last Comment Date
. S IBD=$$FMDIFF^XLFDT(DT,$S('$P(IBEXCEL1,U,17):IBDP,1:$G(DAT)))
. S IBEXCEL1=IBEXCEL1_U_IBD W !,IBEXCEL1 K IBD,IBEXCEL1
;
I 'IBQ,'$G(IBEXCEL) D EN^IBJDF62 ; Print the report.
;
ENQ K ^TMP("IBJDF6P",$J),^TMP("IBJDF6D",$J)
I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
;
D ^%ZISC
ENQ1 K IBA,IBA1,IBAR,IBARD,IBCAT,IBCAT1,IBDIV,IBD,IBI,IBIN,IBQ,IBR,IBOI,IBBA
K IBBN,IBCLM,IBDP,IBEXCEL,IBFR,IBLP,IBOR,IBPTDB,IBTO,IBTYP,COM
K COM1,DAT,DFN,J,X,X1,X2,Y,Z
Q
;
PTDB(X) ; - Find Patient/Debtor and decide to include the AR.
; Input: X=Pointer to the AR in file #430 plus all IBS* variables
; Output: Y=Sort key (name or last 4) and Patient/Debtor IEN(file #2)
; ^ Patient/Debtor name (1st 25 chars) ^ Age ^ SSN
; ^ Processed by (File #200) ^ Current VA Employee? (*=Yes)
N AGE,ALL,ARZ,CAT,DEB,DA,DFN,DIC,DIQ,DR,END,IBZ,INI,KEY,NAME,PRC,SSN
N VA,VADM,VAERR,Y,IBPTFLG
;
S Y="" I '$G(X) G PDQ
S DFN=0,ARZ=$G(^PRCA(430,X,0)),CAT=$P(ARZ,"^",2)
S (NAME,AGE,SSN,PRC)=""
;
; - Look for Patient (Medicare,Tort Feasor,Work's Comp,No-Fault Auto Acc)
S IBPTFLG=$$CATCHK(CAT) ;IB*2.0*618
I IBPTFLG D I 'DFN S Y="" G PDQ
. I '$D(^DGCR(399,X,0)) Q
. S IBZ=^DGCR(399,X,0),DFN=+$P(IBZ,"^",2)
. S INI=IBSNF,END=IBSNL,ALL=IBSNA
. D DEM^VADPT S NAME=VADM(1),SSN=$P(VADM(2),"^",2),AGE=VADM(4)
. S KEY=$S(IBSN="N":NAME,1:$P(SSN,"-",3))
. ; - Look for Debtor (All the other Categories)
I 'IBPTFLG D I 'DFN S Y="" G PDQ
. S DIC="^PRCA(430,",DA=X,DR="9;97",DIQ="DEB" D EN^DIQ1
. S DFN=+$P(ARZ,"^",9) I 'DFN Q
. S NAME=$G(DEB(430,DA,9)),PRC=$G(DEB(430,DA,97)),KEY=NAME
. S DIC="^RCD(340,",DA=DFN,DR="110",DIQ="DEB" D EN^DIQ1
. S SSN=$G(DEB(340,DA,110)) S:SSN=-1 SSN=""
. S INI=IBSDF,END=IBSDL,ALL=IBSDA
;
I (INI'="@"&('DFN)) S Y="" G PDQ
I ALL="ALL"&('DFN)!(ALL="NULL"&(DFN)) S Y="" G PDQ
I INI="@",END="zzzzz" G PDC
I INI]KEY!(KEY]END) S Y="" G PDQ
;
S KEY=KEY_"@@"_DFN
PDC S Y=KEY_U_$E(NAME,1,25)_U_AGE_U_SSN_U_PRC_U_$$VAEMP(+$TR(SSN,"-"))
PDQ Q Y
;
PHDL ; - Print the header line for the Excel spreadsheet
N X
S X="Division^Cat.^Prim.Ins.Carrier^Patient/Debtor^VA Empl.?^SSN^Age^"
S X=X_"Other Ins.Carrier^Bill #^Dt Bill prep.^Bill From Dt^Bill To Dt^"
S X=X_"Orig.Amt^Lst Pymt Amt^Curr.Bal.^Lst Comm.Dt^Days Lst Comm."
W !,X
Q
;
VAEMP(SSN) ; - Check if the Patient/Debtor is a current VA Employee
; Input: SSN - Patient/Debtor Social Security Number
;Output: VAEMP - "*":Current VA Employee / "":Not a Current VA Employee
;
N IEN I 'SSN Q ""
S IEN=+$O(^PRSPC("SSN",SSN,0)) Q:'IEN ""
I $P($G(^PRSPC(IEN,1)),U,33)'="Y" Q "*"
Q ""
;
OTH(DFN,INS,DS) ; - Find a patient's other valid insurance carrier (if any).
; Input: DFN=Pointer to the patient in file #2
; INS=Pointer to the patient's primary carrier in file #36
; DS=Date of service for validity check
; Output: Valid insurance carrier (first 22 chars.) or null
N Y S Y="" G:'$G(DFN)!('$G(DS)) OTHQ
S Z=0 F S Z=$O(^DPT(DFN,.312,Z)) Q:'Z S X=$G(^(Z,0)) D:X Q:Y]""
.I $G(INS),+X=INS Q
.S X1=$G(^DIC(36,+X,0)) Q:X1=""
.I $P(X1,U,2)'="N",$$CHK^IBCNS1(X,DS) S Y=$E($P(X1,U),1,22)
;
OTHQ Q Y
;
COM ; - Get bill comments.
N IBGLB,DAT,IBA1,IBC,COM,COM1,X1,X2
;
S DAT=0,IBA1=$S(IBSH1="M":999999999,1:0)
F S IBA1=$S(IBSH1="M":$O(^PRCA(433,"C",IBA,IBA1),-1),1:$O(^PRCA(433,"C",IBA,IBA1))) Q:'IBA1 D I IBSH1="M",DAT Q
. S IBC=$G(^PRCA(433,IBA1,1)) Q:'IBC
. I $G(IBSH2),$$FMDIFF^XLFDT(DT,+IBC)<IBSH2 Q ; Comment age not minimum.
. I $P(IBC,U,2)'=35,$P(IBC,U,2)'=45 Q ; Not decrease/comment transact.
. S DAT=$S(IBC:+IBC\1,1:+$P(IBC,U,9)\1)
. I $G(IBEXCEL),IBSH1="M" S IBEXCEL1=IBEXCEL1_$$DT^IBJD(DAT,1) Q
. ;
. ; - Append brief and transaction comments.
. K COM,COM1 S COM(0)=DAT,X1=0
. S COM1(1)=$P($G(^PRCA(433,IBA1,5)),U,2)
. S COM1(2)=$E($P($G(^PRCA(433,IBA1,8)),U,6),1,70)
. S COM(1)=COM1(1)_$S(COM1(1)]""&(COM1(2)]""):"|",1:"")_COM1(2)
. I COM(1)]"" S COM(1)="**"_COM(1)_"**",X1=1
. ;
. ; - Get main comments.
. S X2=0 F S X2=$O(^PRCA(433,IBA1,7,X2)) Q:'X2 S COM($S(X1:X2+1,1:X2))=^(X2,0)
. ;
. S X1="" F S X1=$O(COM(X1)) Q:X1="" D
. . S IBGLB=$S(IBCAT1<8:"IBJDF6P",1:"IBJDF6D") ;IB*2.0*618
. . S ^TMP(IBGLB,$J,IBDIV,IBCAT,IBIN,$P(IBPTDB,U),IBBN,IBA1,X1)=COM(X1)
;
Q
CATCHK(IBCAT) ; Check to see if the AR Category should be a patient or Debtor Category
; Output: 1 - Patient, 0 - Debtor (default)
Q:IBCAT=6 1 ;Worker's Comp
Q:IBCAT=7 1 ;No Fault
Q:IBCAT=10 1 ;Tort
Q:IBCAT=21 1 ;Medicare
I (IBCAT>51),(IBCAT<61) Q 1 ; a WC, TORT or NF category for Community Care
Q 0