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