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

IBOHLD1.m

Go to the documentation of this file.
  1. IBOHLD1 ;ALB/CJM - REPORT OF CHARGES ON HOLD W/INS INFO ;MARCH 3 1992
  1. ;;2.0;INTEGRATED BILLING;**70,95,133,356,347,618,651**;21-MAR-94;Build 9
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; modified HELD CHARGES REPORT - includes INS info
  1. ;
  1. MAIN ;
  1. N IBQUIT,IBII,DIRUT,DUOUT,DTOUT,ZTIO,Y S IBQUIT=0
  1. S DIR(0)="Y",DIR("A")="Include Insurance information on this report",DIR("B")="NO"
  1. S DIR("?",1)=" Enter: 'Y' - to include patient insurance information on this report"
  1. S DIR("?",2)=" 'N' - to exclude patient insurance information on this report"
  1. S DIR("?",3)=" '^' - to exit this option"
  1. D ^DIR K DIR G:$D(DIRUT) EXIT S IBII=+Y
  1. ;
  1. QUEUED ; entry point if queued
  1. ;***
  1. K ^TMP($J)
  1. D:'$G(IBQUIT) DEVICE D:'$G(IBQUIT) CHRGS,REPORT^IBOHLD2
  1. D EXIT
  1. ;***
  1. Q
  1. EXIT ;
  1. K ^TMP($J)
  1. K IBRDT,IBRF,IBRX,IBRXN
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. Q
  1. DEVICE ;
  1. I $D(ZTQUEUED) Q
  1. W !!,*7,"*** Margin width of this output is 132 ***"
  1. W !,"*** This output should be queued ***"
  1. S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
  1. I $D(IO("Q")) D Q
  1. . S ZTRTN="QUEUED^IBOHLD1"
  1. . S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
  1. . S ZTDESC="HELD CHARGES RPT W/INS"
  1. . S ZTSAVE("IB*")=""
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS K ZTSK S IBQUIT=1
  1. U IO
  1. Q
  1. ; indexes records that should be included in report
  1. ;
  1. CHRGS ; charges on hold
  1. N IBN,DFN,IBNAME,IBND
  1. S DFN=0 F S DFN=$O(^IB("AH",DFN)) Q:'DFN D PAT S IBN=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D
  1. .S IBND=$G(^IB(IBN,0)) Q:'IBND
  1. .S ^TMP($J,"HOLD",IBNAME,DFN,IBN)=""
  1. .D BILLS
  1. Q
  1. PAT ; patient name
  1. N VAERR,VADM D DEM^VADPT I VAERR K VADM
  1. S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=" "
  1. Q
  1. BILLS ; find bills for charges on hold
  1. N IBFR,IBT,IBATYPE,IBTO
  1. ;***IB*2.0*618
  1. ; Look up the type to match to using the Action Type name
  1. S IBATYPE=$$FNDBTYP($P(IBND,"^",3)) ;end IB*2.0*618
  1. S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)
  1. I IBATYPE="I" D INP
  1. I IBATYPE="O" D OTP
  1. E D RX
  1. Q
  1. ;
  1. FNDBTYP(IBACTIEN) ;Determine what type of 3rd party bill to try and match the
  1. ; held charge to.
  1. ; INPUT - IB Action Type IEN (350.1,.01)
  1. ;
  1. N IBACTPNM
  1. ;
  1. S IBACTPNM=$P($G(^IBE(350.1,IBACTIEN,0)),"^")
  1. I IBACTPNM["OPT" Q "O"
  1. I IBACTPNM["URGENT" Q "O" ;IB*2.0*651 - add CC URGENT CARE as an outpatient
  1. I IBACTPNM["PSO" Q "RX"
  1. I IBACTPNM["RX" Q "O" ;any other RX after PSO link to Outpatient
  1. Q "I" ;assume inpatient if not matched above
  1. ;
  1. INP ; inpatient bills
  1. N IBEV,IBBILL,IBT,X,X1,X2,IBEND,IBOK
  1. S IBEV=$P(IBND,"^",16) Q:'IBEV ; parent event
  1. S IBEV=($P($G(^IB(IBEV,0)),"^",17)\1) Q:'IBEV ; date of parent event
  1. S X1=IBEV,X2=1 D C^%DTC S IBEND=X
  1. 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
  1. .D INPTCK
  1. .I IBOK S ^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)=""
  1. Q
  1. ;
  1. INPTCK ; does bill belong to charge? returns IBOK=0 if no
  1. N IBBILL0,IBBILLU
  1. S IBBILL0=$G(^DGCR(399,IBBILL,0)),IBBILLU=$G(^("U"))
  1. S IBOK=1
  1. CK1 ; for same patient?
  1. I DFN=$P(IBBILL0,"^",2)
  1. S IBOK=$T
  1. Q:'IBOK
  1. CK2 ; same type- inp or opt?
  1. N B S B=$S(+$P(IBBILL0,"^",5)<3:"I",1:"O")
  1. I B=IBATYPE
  1. S IBOK=$T
  1. Q:'IBOK
  1. CK3 ; overlap in date range?
  1. N F,T
  1. S F=+IBBILLU,T=$P(IBBILLU,"^",2)
  1. I (IBTO<F)!(IBFR>T)
  1. S IBOK='$T
  1. Q:'IBOK
  1. CK4 ; insurance bill?
  1. I $P(IBBILL0,"^",11)="i"
  1. S IBOK=$T
  1. Q
  1. OTP ; outpatient bills
  1. N X,IBV,IBBILL,IBOK,IBBILL0
  1. S IBV=(IBFR\1)-.0001 F S IBV=$O(^DGCR(399,"AOPV",DFN,IBV)) Q:'IBV!(IBV>IBTO) S IBBILL=0 D
  1. .F S IBBILL=$O(^DGCR(399,"AOPV",DFN,IBV,IBBILL)) Q:('IBBILL) D
  1. ..Q:$D(^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL))
  1. ..S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 Q:'IBOK
  1. ..S ^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)=""
  1. Q
  1. RX ; rx refill bills
  1. S (IBRX,IBRXN,IBRF,IBRDT)=0 N IENS
  1. I $P(IBND,"^",4)'["52:" Q
  1. ;
  1. S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
  1. ;
  1. I +IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
  1. I +IBRF=0 S IBRDT=$$FILE^IBRXUTL(+IBRXN,22)
  1. ;
  1. Q:(IBRX="")!('IBRDT)
  1. N X,IBBILL,IBBILL0,IBFILL,IBFILL0,IBOK S IBBILL=0
  1. S IBFILL=0 F S IBFILL=$O(^IBA(362.4,"B",IBRX,IBFILL)) Q:IBFILL="" D
  1. .S IBFILL0=$G(^IBA(362.4,IBFILL,0)) I $P(IBFILL0,"^",3)'=IBRDT Q
  1. .S IBBILL=+$P(IBFILL0,"^",2) I 'IBBILL Q
  1. .S IBBILL0=$G(^DGCR(399,IBBILL,0)) D CK4 I 'IBOK Q
  1. .S ^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)=""
  1. Q