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 28 Sep 2018 01:53:42PM
IBOHLS1^INT^1^64919,49993.717189^0
IBOHLS1 ;ALB/BAA - IB HELD CHARGES LIST MANAGER ;08-SEP-2015
;;2.0;INTEGRATED BILLING;**554,616,618**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
;
SORT ; get the data
N CNT,IBN,SINST
S CNT=0
; compile data to display here
I 'PATS D
. S IBN=0 F S IBN=$O(^IB("AC",8,IBN)) Q:'IBN D CHRGS(IBN,PATS)
I PATS D
. S DFN=0 F S DFN=$O(FILTERS(2,DFN)) Q:'DFN D
.. S IBN=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D CHRGS(IBN,PATS)
Q
;
CHRGS(IBN,PATS) ; charges on hold
N IBFR,IBTO,HDAYS,IBND,HINST,DFN,HST,IBACT,IBCHG,ID,SS,SSLE,SSLS,NAME,HLDT,FLAG
N CLINIC,IBND1,RSLTFRM
S SINST=""
S IBND=$G(^IB(IBN,0)) Q:'IBND
S RSLTFRM=$P(IBND,U,4)
S HINST=$$INST(RSLTFRM),CLINIC=$P(HINST,U,2),HINST=$P(HINST,U,1)
S FLAG=""
I HINST="*" S FLAG="*",HINST=$P(IBND,U,13)
I HINST="" S FLAG="*",HINST=$P(IBND,U,13)
I HINST'="" S SINST=$P(^DIC(4,HINST,0),U,1)
I INSTS,HINST="" Q
I INSTS,'$D(FILTERS(1,HINST)) Q
S IBND1=$G(^IB(IBN,1))
S HLDT=$P(IBND1,U,6)
S IBACT=+IBND
S DFN=$P(IBND,U,2)
D PAT
S HST=$P(IBND,U,5)
I HST'=8 Q
S IBFR=$P(IBND,U,14),IBTO=$P(IBND,U,15)
I $P(IBND,U,4)["52:" D
.S IBRXN=$P($P(IBND,U,4),":",2),IBRF=$P($P(IBND,U,4),":",3)
.I +IBRF>0 S IBFR=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01),IBTO=$P($$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,17),".")
.I +IBRF=0 S IBFR=$$FILE^IBRXUTL(+IBRXN,22),IBTO=$P($$FILE^IBRXUTL(+IBRXN,31),".")
I HLDT<BDATE!(HLDT>EDATE) Q
S HDAYS=$$FMDIFF^XLFDT(DT,HLDT,1)
S IBCHG=$P(IBND,U,7)
D BILLS
Q
;
INST(RF) ; figure out where performed
N FL,IEN,IBIEN,DIEN,INT,CLNM,IBSTA
S IBRXN=$P(RF,":",2),INT="*",CLNM=""
S IBIEN=$P(IBRXN,";",1)
S FL=$P(RF,":",1)
;
I FL=350 S INT="*",CLNM=""
;
I FL=45 D
. S IBSTA=$$GET1^DIQ(45,IBIEN_",",3,"I"),CLNM="" ;IB*2*616, 45 file stores Station Number
. D FIND^DIC(4,"","@;.01;IX","X",IBSTA,99,"D","","","MSG") S INT=$G(MSG("DILIST",2,1)) ;Convert Station number to Institution file IEN
;
I FL=52 D
. S IEN=$$GET1^DIQ(52,IBIEN_",",20,"I"),CLNM=$$GET1^DIQ(52,IBIEN_",",20,"E")
. S INT=$$GET1^DIQ(59,IEN_",",100,"I")
;
I FL=405 D
. S IEN=$$GET1^DIQ(405,IBIEN_",",.06,"I"),CLNM=$$GET1^DIQ(405,IBIEN_",",.06,"E")
. S DIEN=$$GET1^DIQ(42,IEN_",",.015,"I")
. S INT=$$GET1^DIQ(40.8,DIEN_",",.07,"I")
;
I FL=409.68 D
. S IEN=$$GET1^DIQ(409.68,IBIEN_",",.04,"I"),CLNM=$$GET1^DIQ(409.68,IBIEN_",",.04,"E")
. S INT=$$GET1^DIQ(44,IEN_",",3,"I")
;
Q INT_U_CLNM
;
;
PAT ; patient name
N VAERR,VADM D DEM^VADPT I VAERR K VADM
S NAME=$G(VADM(1)) S:NAME="" NAME=" "
S SS=$P($G(VADM(2)),U,1),SSLE=$L(SS),SSLS=6 I $E(SS,SSLE)="P" S SSLS=5
S ID=$E(NAME,1)_$E(SS,SSLS,SSLE)
Q
;
BILLS ; find bills for charges on hold
N IBT,IBATYPE,IBCHRG,IBTP
; Look up the type to match to using the Action Type name
S IBATYPE=$$FNDBTYP^IBOHLD1($P(IBND,"^",3)) ;IB*2.0*618
S CNT=CNT+1
; Patch IB*2.0*618 - added community care - action types to HELD CHARGES report
S IBTP=$P(IBND,"^",3),IBTP=$P($G(^IBE(350.1,IBTP,0)),"^",1)
S IBTP=$$IBACTYPE^IBOHLD2(IBTP)
; end of Patch IB*2.0*618
S ^TMP($J,"IBOHLS",NAME,CNT)=NAME_U_ID_U_IBTP_U_IBFR_U_IBTO_U_HDAYS_U_IBCHG
S ^TMP($J,"IBOHLS",NAME,CNT,"IBND")=DFN_U_NAME_U_IBN_U_IBFR_U_IBTO_U_SINST_U_FLAG_U_CLINIC
I IBATYPE="I" D INP
I IBATYPE="O" D OTP
E D RX
I IINS,$D(^TMP($J,"IBOHLS",NAME,CNT)),'$D(^TMP($J,"IBOHLS INS",NAME)) D GETINS
Q
;
INP ; inpatient bills
N IBEV,IBBILL,IBT,X,X1,X2,IBEND,IBOK,IBBCHG,IBBILL0,IBBILLU1,BILL,BCNT,BLTRK,RNB,STATUS
N HLDDT,AUDT,IBTYPE
S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1),IBTYPE=$S(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$E(IBTYPE,4,7))
S IBEV=$P(IBND,U,16) Q:'IBEV ; parent event
S IBEV=($P($G(^IB(IBEV,0)),U,17)\1) Q:'IBEV ; date of parent event
S X1=IBEV,X2=1 D C^%DTC S IBEND=X
S BCNT=0
S IBT=(IBEV-.0001) F S IBT=$O(^DGCR(399,"D",IBT)) Q:'IBT!(IBT'<IBEND) S IBBILL=0 F S IBBILL=$O(^DGCR(399,"D",IBT,IBBILL)) Q:IBBILL="" D
. S IBBILL0=$G(^DGCR(399,IBBILL,0))
. S BILL=$P(IBBILL0,U,1)
. S AUDT=$$GET1^DIQ(399,IBBILL,10,"I")
. S HLDDT=$S(AUDT'="":$$FMDIFF^XLFDT(DT,AUDT,1),1:HDAYS)
. S IBBCHG=$$GET1^DIQ(430,IBBILL,77)
. S STATUS=$$GET1^DIQ(430,IBBILL,8,"O")
. S (BLTRK,RNB)=""
. S BLTRK=$O(^IBT(356,"E",IBBILL,BLTRK))
. I BLTRK'="" S RNB=$$GET1^DIQ(356,BLTRK,.19,"O")
. D INPTCK
. I IBOK D
.. ;BILL#AR STATUS^DATE BILLED^AUTH DATE^HLD DAYS^CHARGE^RNB^BILL TRK #
.. S BCNT=BCNT+1
.. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT)=BILL_U_STATUS_U_IBT_U_AUDT_U_HLDDT_U_IBBCHG_U_RNB_U_BLTRK ;BILL#^AR STATUS^DATE BILLED^CHARGE
.. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT,"B")=IBBILL_U_BLTRK_U_RNB
Q
;
INPTCK ; does bill belong to charge? returns IBOK=0 if no
N IBBILLU
S IBBILLU=$G(^DGCR(399,IBBILL,"U"))
S IBBILL=$P(IBBILL0,U,1)
S IBOK=1
CK1 ; for same patient?
I DFN=$P(IBBILL0,U,2)
S IBOK=$T
Q:'IBOK
CK2 ; same type- inp or opt?
N B S B=$S(+$P(IBBILL0,U,5)<3:"I",1:"O")
I B=IBATYPE S IBOK=1
S IBOK=$T
Q:'IBOK
CK3 ; overlap in date range?
N F,T
S F=+IBBILLU,T=$P(IBBILLU,U,2)
I (IBTO<F)!(IBFR>T)
S IBOK='$T
Q:'IBOK
CK4 ; insurance bill?
I $P(IBBILL0,U,11)="i"
S IBOK=$T
Q
;
OTP ; outpatient bills
N X,IBV,IBBILL,IBOK,IBBILL0,IBBCHG,IBBILLU1,IBBILLU,BILL,BCNT
S BCNT=0
S IBV=(IBFR\1)-.0001 F S IBV=$O(^DGCR(399,"AOPV",DFN,IBV)) Q:'IBV!(IBV>IBTO) S IBBILL=0 D
.F S IBBILL=$O(^DGCR(399,"AOPV",DFN,IBV,IBBILL)) Q:('IBBILL) D
.. S IBBILL0=$G(^DGCR(399,IBBILL,0)),IBBILLU=$G(^DGCR(399,IBBILL,"U")) D CK4 Q:'IBOK
.. S BILL=$P(IBBILL0,U,1)
.. S AUDT=$$GET1^DIQ(399,IBBILL,10,"I")
.. S HLDDT=$S(AUDT'="":$$FMDIFF^XLFDT(DT,AUDT,1),1:HDAYS)
.. S IBBCHG=$$GET1^DIQ(430,IBBILL,77)
.. S STATUS=$$GET1^DIQ(430,IBBILL,8,"O")
.. S (BLTRK,RNB)=""
.. S BLTRK=$O(^IBT(356,"E",IBBILL,BLTRK))
.. I BLTRK'="" S RNB=$$GET1^DIQ(356,BLTRK,.19,"O")
.. S BILL=$P(IBBILL0,U,1),BCNT=BCNT+1
.. S IBBILLU1=$G(^DGCR(399,IBBILL,"U1")),IBBCHG=$P(IBBILLU1,U,1)
.. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT)=BILL_U_STATUS_U_IBV_U_AUDT_U_HLDDT_U_IBBCHG_U_RNB_U_BLTRK ;BILL#^AR STATUS^DATE BILLED^AUTH DATE^DAYS ON HOLD^CHARGE^RNB^BILL TRK NO
.. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT,"B")=IBBILL_U_BLTRK
Q
;
RX ; rx refill bills
N IBRDT,IBRF,IBRX,IBRXN,IBTYPE
S (IBRX,IBRXN,IBRF,IBRDT)=0 N IENS
I $P(IBND,U,4)'["52:" Q
;
S IBTYPE=$P(IBND,"^",3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),"^",1),IBTYPE=$S(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$E(IBTYPE,4,7))
S IBRXN=$P($P(IBND,U,4),":",2),IBRX=$P($P(IBND,U,8),"-"),IBRF=$P($P(IBND,U,4),":",3)
S ^TMP($J,"IBOHLS",NAME,CNT,1)=IBRX ;RX VALUE
I +IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
I +IBRF=0 S IBRDT=$$FILE^IBRXUTL(+IBRXN,22)
;
Q:(IBRX="")!('IBRDT)
N X,IBBILL,IBBILL0,IBFILL,IBFILL0,IBOK,IBBCHG,BCNT
S BCNT=0
S IBFILL=0 F S IBFILL=$O(^IBA(362.4,"B",IBRX,IBFILL)) Q:IBFILL="" D
. S BCNT=BCNT+1
. S IBFILL0=$G(^IBA(362.4,IBFILL,0)) I $P(IBFILL0,U,3)'=IBRDT Q
. S IBBILL=+$P(IBFILL0,U,2) I 'IBBILL Q
. S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 I 'IBOK Q
. S BILL=$P(IBBILL0,U,1)
. S AUDT=$$GET1^DIQ(399,IBBILL,10,"I")
. S HLDDT=$S(AUDT'="":$$FMDIFF^XLFDT(DT,AUDT,1),1:HDAYS)
. S IBBCHG=$$GET1^DIQ(430,IBBILL,77)
. S STATUS=$$GET1^DIQ(430,IBBILL,8,"O")
. S (BLTRK,RNB)=""
. S BLTRK=$O(^IBT(356,"E",IBBILL,BLTRK))
. I BLTRK'="" S RNB=$$GET1^DIQ(356,BLTRK,.19,"O")
. S BCNT=BCNT+1
. S IBBILLU1=$G(^DGCR(399,IBBILL,"U1")),IBBCHG=$P(IBBILLU1,U,1)
. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT)=BILL_U_STATUS_U_IBRDT_U_AUDT_U_HLDDT_U_IBBCHG_U_RNB_U_BLTRK ;BILL#^AR STATUS^DATE BILLED^CHARGE
. S ^TMP($J,"IBOHLS",NAME,CNT,2,BCNT,"B")=IBBILL_U_BLTRK_U_RNB
Q
;
GETINS ; get insurance information
N XX,IBINS,IBX,ICNT,INSCO,SUBID,PLNID,EFFDT,EFDTCK,EXPDT,EXDTCK,LEDT,SUBNAM,CVD
N PLNCOV,PEFDT,PCOVD,PCOM,PCNT,COVFN,GRP,CKDT,IBCNT
N IBINS0,IBINS7,LIM,INSTYP,IB0,IBS,REIMB
S (PLNCOV,PLNID,PEFDT,PCOVD,PCOM)=""
S ICNT=0
D ALL^IBCNS1(DFN,"IBINS")
S XX=0
F S XX=$O(IBINS(XX)) Q:'XX D
. S IBINS0=IBINS(XX,0)
. S IBINS7=$G(IBINS(XX,7))
. S PLNID=$P(IBINS0,U,18),GRP=$P(IBINS0,U,3)
. I PLNID'="" I $P($G(^IBA(355.3,PLNID,0)),"^",11) Q ;plan is inactive
. S INSCO=$P(^DIC(36,+IBINS0,0),U,1),REIMB=$P(INSCO,U,2)
. I $P(INSCO,U,5) Q ;insurance company inactive
. S SUBID=$P(IBINS7,U,2)
. S SUBNAM=$P(IBINS7,U,1)
. S EXDTCK=+$P(IBINS0,U,4)
. S EFDTCK=+$P(IBINS0,U,8)
. I EXDTCK,EXDTCK<IBFR Q ; if insurance expired before the from date of copay quit
. I EFDTCK,EFDTCK>IBTO Q ; if insurance not in effect for period quit
. S EFFDT=$$DAT1^IBOUTL(EFDTCK)
. S EXPDT=$$DAT1^IBOUTL(EXDTCK)
. S ICNT=ICNT+1
. ;ins co^sub id^plan id^effective dt^expiration date
. S ^TMP($J,"IBOHLS",NAME,CNT,3,ICNT)=IBINS0_U_PLNID
. S ^TMP($J,"IBOHLS INS",NAME,ICNT)=INSCO_U_SUBNAM_U_GRP_U_EFFDT_U_EXPDT
. ;plan coverage^effective date^covered?^limit comments
. S LIM=0,PCNT=0
. F S LIM=$O(^IBE(355.31,LIM)) Q:'LIM D
.. S PLNCOV=$P($G(^IBE(355.31,LIM,0)),U),IBCNT=0,PEFDT=""
.. S PCOVD="",LEDT="",PCOM=""
.. F S LEDT=$O(^IBA(355.32,"APCD",PLNID,LIM,LEDT)) Q:$S(LEDT="":IBCNT,1:0) D Q:LEDT=""
... S COVFN=+$O(^IBA(355.32,"APCD",PLNID,LIM,+LEDT,"")),PCOVD=$G(^IBA(355.32,+COVFN,0))
... S PEFDT=$$DAT1^IBOUTL($P(LEDT,"-",2))
... I PCOVD="" S PCOVD="BY DEFAULT" D SETINS(PLNCOV,PEFDT,PCOVD,PCOM,IBCNT) Q
... S IBCNT=IBCNT+1,PCOM=""
... I PCOVD'="" S CVD=$P(PCOVD,U,4),PCOVD=$S(CVD:$S(CVD<2:"YES",CVD=2:"CONDITIONAL",1:"UNKNOWN"),1:"NO")
... I '$O(^IBA(355.32,COVFN,2,0)) D SETINS(PLNCOV,PEFDT,PCOVD,PCOM,IBCNT) Q
... S (IBS,IB0)=0 F S IB0=$O(^IBA(355.32,COVFN,2,IB0)) Q:'IB0 D
.... S PCOM=""
.... S PCOM=^IBA(355.32,COVFN,2,IB0,0)
.... I IBS=0 D SETINS(PLNCOV,PEFDT,PCOVD,PCOM,IBCNT)
.... I IBS>0 D SETCOV(PCOM)
.... S IBS=IBS+1
Q
;
SETINS(PLNCOV,PEFDT,PCOVD,PCOM,IBCNT) ; SET GLOBAL ENTRY
S PCNT=PCNT+1
I IBCNT>1 S PLNCOV=""
S ^TMP($J,"IBOHLS",NAME,CNT,3,ICNT,PCNT)=""
S ^TMP($J,"IBOHLS INS",NAME,ICNT,0)=IBINS0_U_PLNID
S ^TMP($J,"IBOHLS INS",NAME,ICNT,PCNT)=PLNCOV_U_PEFDT_U_PCOVD_U_PCOM
Q
;
SETCOV(PCOM) ; SET COVERAGE WHEN MULTIPLE
S PCNT=PCNT+1
S ^TMP($J,"IBOHLS INS",NAME,ICNT,PCNT)=""_U_""_U_""_U_PCOM
Q