IBCONS2 ;ALB/CPM - NSC W/INSURANCE OUTPUT (CON'T) ;31-JAN-92
;;2.0;INTEGRATED BILLING;**19,36,54,66,91,99,108,120,142,174,155**;21-MAR-94
;
;MAP TO DGCRONS2
;
LOOP1 ; Compilation for both Inpatient Admisssion and Discharge reports.
N DA,IBADM K ^TMP($J,"PATIENT INCLUDE"),^TMP($J,"PATIENT EXCLUDE")
D DIV
F I=(IBBEG-.0001):0 S I=$O(^DGPM(IBSUB,I)) Q:'I!(I>(IBEND+.99)) D
. S DFN=0 F S DFN=$O(^DGPM(IBSUB,I,DFN)) Q:'DFN S DA=+$O(^(DFN,0)) D D:PTF PTF I $G(IBDV) D PROC K IBADMVT
.. S:IBINPT=2 DA=+$P($G(^DGPM(DA,0)),"^",14),IBADM=+$G(^DGPM(DA,0))
.. S PTF=$P($G(^DGPM(DA,0)),"^",16)
.. S IBADMVT=DA
.. S IBDV=+$P($G(^DIC(42,+$P($G(^DGPM(DA,0)),"^",6),0)),"^",11)
K ^TMP($J,"PATIENT INCLUDE"),^TMP($J,"PATIENT EXCLUDE")
Q
;
;
LOOP2 ; Compilation for the Outpatient report
N DFN,IBDTA,IBDV,IBVAL,IBFILTER,IBCBK,IBNO,IBOE,IBOE0,IBSTOP,IBOEZ,Y,Y0,IBQUERY2
D DIV K ^TMP($J,"PATIENT INCLUDE"),^TMP($J,"PATIENT EXCLUDE")
;
S IBQUERY2=""
S IBVAL("BDT")=IBBEG,IBVAL("EDT")=IBEND+.99
S IBFILTER="I '$P(Y0,U,6)"
S IBCBK="D CALLBCK^IBCONS2(Y,Y0,.IBQUERY2)"
K ^TMP("IBOEC",$J)
D SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
I $G(IBQUERY2) D CLOSE^IBSDU(IBQUERY2)
;
; Process stand-alone add/edits extracted
S DFN=0 F S DFN=$O(^TMP("IBOEC",$J,DFN)) Q:'DFN I $D(^DPT(DFN,0)) D
. S IBDTA=0 F S IBDTA=$O(^TMP("IBOEC",$J,DFN,IBDTA)) Q:'IBDTA D
.. K IBOE,IBSTOP,IBCOMB
.. S IBNO=1
.. S IBOEZ=0 F S IBOEZ=$O(^TMP("IBOEC",$J,DFN,IBDTA,IBOEZ)) Q:'IBOEZ S IBOE0=$$SCE^IBSDU(IBOEZ,"",0) D
... S IBDV=$P(IBOE0,U,11)
... S:$L($G(IBOE(IBNO)))+$L(IBOEZ)+1>200 IBNO=IBNO+1
... S IBOE(IBNO)=$G(IBOE(IBNO))_IBOEZ_U I '$G(IBOE) S IBOE=+IBOE(1)
... S Z=+$P($G(^DIC(40.7,+$P(IBOE0,U,3),0)),U,2) S:Z IBCOMB(Z)=$G(IBCOMB(Z))+1
.. S:'$D(IBSTOP) IBSTOP="Add/Edit Stop Code^"
.. S Z=0 F S Z=$O(IBCOMB(Z)) Q:'Z S IBSTOP=IBSTOP_Z_$S(IBCOMB(Z)=1:"",1:"(x"_IBCOMB(Z)_")")_U
.. ;
.. S I=IBDTA
.. I $G(IBOE) D PROCO ;All add/edit encounters for a patient/date on a single line
;
K ^TMP("IBOEC",$J),^TMP($J,"PATIENT INCLUDE"),^TMP($J,"PATIENT EXCLUDE")
Q
;
CALLBCK(IBOE,IBOE0,IBQUERY2) ; Executed by scan call back logic to process encounters
; IBOE = encounter ien
; IBOE0 = 0-node of the encounter
;
N DFN,I,IBDC,IBDS,IBDV,IBSTOP,IBT,Z
I '$$BDSRC^IBEFUNC3($P($G(IBOE0),U,5)) Q ; non-billable visit data source
;
S IBT=$P(IBOE0,U,8),DFN=$P(IBOE0,U,2),IBDV=$P(IBOE0,U,11),(IBDS,IBDC)=""
S I=+IBOE0
Q:'I Q:DFN=""
I IBT=1 D
. S IBDC=+$P(IBOE0,U,4)
. I IBDV="" S IBDV=$P($G(^SC(IBDC,0)),U,15)
;
I IBT=3 D
. S IBDS=$$DISND^IBSDU(IBOE,IBOE0)
. I IBDV="" S IBDV=$P(IBDS,U,4)
;
Q:'$$VALID()
;
; Screen to only include 1-3 originating process and
; for 1 or 2, include only those that have appt types indicating they
; are included on reports
;
I $S(IBT<3:$$RPT^IBEFUNC($P(IBOE0,U,10),+IBOE0),1:IBT=3) D
. ; Extract add/edits to global so we can combine the data into one line (2 lines if RNB defined)
. I IBT=2 D Q ; Stand-alone Add/Edits
.. I VAUTD'=1 Q:'$D(VAUTD(+IBDV))
.. I VAUTD=1 Q:'IBDV
.. I +$$RNBOE(IBOE) S ^TMP("IBOEC",$J,DFN,(IBOE0\1)_".",IBOE)="" Q
.. S ^TMP("IBOEC",$J,DFN,IBOE0\1,IBOE)=""
. ;
. I IBT=1 D Q ;Appointments
.. I IBDC D
... S X=$$CHILD(IBOE,IBOE0,.IBVAL,.IBSTOP,.IBQUERY2)
... S IBSTOP="Clinic: "_$P($G(^SC(IBDC,0)),U)_$S('X:"",1:" -- "_IBSTOP)
... S I=+IBOE0 D PROCO
. ;
. I IBT=3 D Q ;Registration
.. N X
.. Q:'$$DISCT^IBEFUNC(IBOE,IBOE0)
.. S X=$$CHILD(IBOE,IBOE0,.IBVAL,.IBSTOP,.IBQUERY2)
.. S IBSTOP="Registration: "_$P($G(^DIC(37,+$P(IBDS,U,7),0)),U)_$S('X:"",1:" -- "_IBSTOP)
.. S I=+IBOE0 D PROCO
;
Q
;
CHILD(IBOE,IBOE0,IBVAL,IBSTOP,IBQUERY2) ;Find any child add/edits
; IBSTOP and IBQUERY2 are returned
N IBVAL1,IBFILTER,IBCBK,IBCOMB,Z
M IBVAL1=IBVAL
S (IBFILTER,IBSTOP)="",IBVAL1("DFN")=+$P(IBOE0,U,2)
S IBCBK="I $S(Y=IBOE:1,1:$P(Y0,U,6)=IBOE),$P(Y0,U,3),$$RPT^IBEFUNC($P(Y0,U,10),+Y0) S Z=+$P($G(^DIC(40.7,+$P(Y0,U,3),0)),U,2) S:Z IBCOMB(Z)=$G(IBCOMB(Z))+1"
D SCAN^IBSDU("PATIENT/DATE",.IBVAL1,IBFILTER,IBCBK,0,.IBQUERY2) K ^TMP("DIERR",$J)
S Z=0 F S Z=$O(IBCOMB(Z)) Q:'Z S IBSTOP=$S(IBSTOP="":"Stop Codes^",1:IBSTOP)_Z_$S(IBCOMB(Z)=1:"",1:"(x"_IBCOMB(Z)_")")_U
Q (IBSTOP'="")
;
PROC ; -process each episode of care
Q:'$$VALID()
PROCO ; Entrypoint for outpatient loop2
K IBRMARK
I '$G(IBSC) D TRACK^IBCONS3 ; -find tracking entry get reason not billable
I +$G(IBSC) S IBRMARK="{ALL MOVES SC}" ; stays with all SC moves not added to CT but on rpt w/RNB ** PATCH 66
D BILL,SET ; -on billed or unbilled list
Q
;
VALID() ;
N IBOK
S IBOK=0
I +$G(IBSELRNG),$D(^TMP($J,"PATIENT EXCLUDE",DFN)) G VALIDQ ; pat already excluded from select range ** PATCH 66
I +$G(IBSELRNG),+$G(IBSELRNG)<3,'$$PAT(DFN) G VALIDQ ; patient in selected range ** PATCH 66
I VAUTD'=1 G:'$D(VAUTD(+IBDV)) VALIDQ
I VAUTD=1 G:'IBDV VALIDQ
D PTCHK G:'IBFLAG VALIDQ ; -is patient a vet and have ins data
D INS G:'IBFLAG VALIDQ ; -is insurance valid for date of care
I +$G(IBSELRNG)=3,'$$PTINS(DFN) G VALIDQ ; patient ins is included in range ** PATCH 66
S IBOK=1
VALIDQ Q IBOK
;
INS S IBFLAG=$$INSURED^IBCNS1(DFN,I)
I +IBFLAG,+IBINPT,'$$PTCOV^IBCNSU3(DFN,+I,"INPATIENT") S IBFLAG=0
Q
;
PTCHK S IBFLAG=0 I $D(^DPT(+DFN,.312)),$G(^("VET"))="Y" S IBFLAG=1
; Patch #36 - removes non-veteran eligibilities and inpatient visits
I 'IBINPT D
.N IBTEMP,IBOE0 S IBTEMP=$$SCE^IBSDU(+IBOE,13,0),IBOE0=$$SCE^IBSDU(+IBOE)
.I $P($G(^DIC(8,+IBTEMP,0)),U,5)="N" S IBFLAG=0 Q
.I '$$APPTCT^IBEFUNC(IBOE0) S IBFLAG=0 Q
Q
;
SET N DPT0,IBSUBSC2,IBSUBSC3,IBSUBSC4,IBSUBSC6 S DPT0=$G(^DPT(+DFN,0))
S IBSUBSC2=+IBDV I +$G(IBSELCDV) S IBSUBSC2="COMBINED"
S IBSUBSC3=$S(B]"":2,1:1)
S IBSUBSC4=$P(DPT0,U,1) I +$G(IBSELTRM) S IBSUBSC4=+$$TERMDG(DFN)
S IBSUBSC6=I F IBSUBSC6=IBSUBSC6:.000001 Q:'$D(^TMP($J,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6))
S ^TMP($J,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6)=B
I $D(IBSTOP),'$D(^TMP($J,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6,1)) S ^(1)=IBSTOP
I $G(IBRMARK)'="" S ^TMP($J,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6,2)=$G(IBRMARK)
K IBSTOP,IBRMARK
Q
;
BILL ; Add to billed list if is insurance bill, not canceled
; if opt, date is in list, if inpt, admission date = event date
; ** PATCH 66 modified to include check for bill authorized status and add that to the stored TMP array
;
S B="",I1=$S(IBINPT=2:IBADM,IBINPT:I,1:I\1),IBAUTH=2 N IB0
; -- the following line modified in patch 19 to check for only inpt. bills ($p(^(0),u,5)<3) are counted as bills,
; for when there is an outpatient bill with the same event date.
I IBINPT,$D(^DGCR(399,"C",DFN)) F M=0:0 S M=$O(^DGCR(399,"C",DFN,M)) Q:'M D Q:$L(B)>200
. S IB0=$G(^DGCR(399,M,0))
. I IB0'="",$P(IB0,"^",5)<3,$P(IB0,"^",13)<7,$P($P(IB0,"^",3),".")=$P(I1,"."),$P(IB0,"^",11)="i" S B=B_M_"^" I $P(IB0,"^",13)<2 S IBAUTH=1
;
I 'IBINPT,$D(^DGCR(399,"AOPV",DFN,I1)) F M=0:0 S M=$O(^DGCR(399,"AOPV",DFN,I1,M)) Q:'M D Q:$L(B)>200
. S IB0=$G(^DGCR(399,M,0))
. I IB0'="",$P(IB0,"^",13)<7,$P(IB0,"^",11)="i" S B=B_M_"^" I $P(IB0,"^",13)<2 S IBAUTH=1
I +B S B=IBAUTH_"^"_B
Q
;
PTF ; if all movements are for sc condition then not billable
;
S IBSC="" Q:'$D(^DGPT(+PTF))
S IBMOV=0 F S IBMOV=$O(^DGPT(PTF,"M",IBMOV)) Q:'IBMOV S IBSC=$P($G(^(IBMOV,0)),"^",18) I IBSC=2!(IBSC="") Q
S IBSC=$S(IBSC=2!(IBSC=""):0,1:1)
Q
DIV ;adds the requested divisions to the report
N IBDIV I +$G(IBSELCDV) S ^TMP($J,"COMBINED")="" Q
I VAUTD'=1 D
.S IBDIV="" F S IBDIV=$O(VAUTD(IBDIV)) Q:'IBDIV S ^TMP($J,IBDIV)=""
I VAUTD=1 D
.S IBDIV="" F S IBDIV=$O(^DG(40.8,IBDIV)) Q:IBDIV']""!(+IBDIV'=IBDIV) I $P($G(^DG(40.8,IBDIV,0)),"^",1)]"" S ^TMP($J,IBDIV)=""
Q
;
PAT(DFN) ; true if patient is included in range requested ** PATCH 66
N IBX,IBY S IBX=1
I $D(^TMP($J,"PATIENT INCLUDE",DFN)) S IBX=1 G PATQ
I $D(^TMP($J,"PATIENT EXCLUDE",DFN)) S IBX=0 G PATQ
;
I +$G(IBSELRNG)=2 S IBY=$$TERMDG(DFN) D
. I IBY<$G(IBSELSR1) S IBX=0
. I +$G(IBSELSR2),IBY>IBSELSR2 S IBX=0
;
I +$G(IBSELRNG)=1 S IBY=$P($G(^DPT(+DFN,0)),U,1),IBX=$$STGRNG(IBY)
;
I +IBX S ^TMP($J,"PATIENT INCLUDE",DFN)=""
I 'IBX S ^TMP($J,"PATIENT EXCLUDE",DFN)=""
PATQ Q IBX
;
PTINS(DFN) ; check if patients ins is within selected range ** PATCH 66
N IBY,IBX,IBAR,IBI S IBX=1
I $D(^TMP($J,"PATIENT INCLUDE",DFN)) S IBX=1 G PTINSQ
I $D(^TMP($J,"PATIENT EXCLUDE",DFN)) S IBX=0 G PTINSQ
;
I $G(IBSELRNG)=3 D ALL^IBCNS1(DFN,"IBAR",1,IBBEG),ALL^IBCNS1(DFN,"IBAR",1,IBEND) S IBX=0
S IBI=0 F S IBI=$O(IBAR(IBI)) Q:'IBI S IBY=+$G(IBAR(IBI,0)),IBY=$P($G(^DIC(36,+IBY,0)),U,1) I +$$STGRNG(IBY) S IBX=1 Q
;
I +IBX S ^TMP($J,"PATIENT INCLUDE",DFN)=""
I 'IBX S ^TMP($J,"PATIENT EXCLUDE",DFN)=""
PTINSQ Q IBX
;
STGRNG(STRNG) ; check if the string passed in is contained within the selected ASCII range ** PATCH 66
N IBSB,IBSE,IBI,IBY,IBX S IBX=1,STRNG=$$ASCII($G(STRNG))
F IBI=1:1 S IBSB=$P($G(IBSELSR1),",",IBI),IBY=$P(STRNG,",",IBI) Q:'IBSB Q:IBSB<IBY I IBSB>IBY S IBX=0 Q
F IBI=1:1 S IBSE=$P($G(IBSELSR2),",",IBI),IBY=$P(STRNG,",",IBI) Q:'IBSE Q:IBSE>IBY I IBSE<IBY S IBX=0 Q
Q IBX
;
ASCII(STRNG) ; returns string in ASCII ** PATCH 66
N IBI,IBX,IBY S IBX=""
I $G(STRNG)'="" F IBI=1:1 S IBY=$E(STRNG,IBI) Q:IBY="" S IBX=IBX_$A(IBY)_"," Q:$L(IBX)>196
Q IBX
;
TERMDG(DFN) ; returns a patients terminal digit ** PATCH 66
N TERMD,DPT0,SSN S TERMD="",DPT0=$G(^DPT(+DFN,0)),SSN=$P(DPT0,"^",9)
S TERMD=$E(SSN,8,9)_$E(SSN,6,7)_$E(SSN,4,5)_$E(SSN,1,3)
Q TERMD
;
RNBOE(IBOE) ; return a Reason Not Billable for the encounter if one can be found
N IBX,IBR S IBR="" I +$G(IBOE) S IBX=+$O(^IBT(356,"ASCE",+IBOE,0)) I +IBX S IBR=$P($G(^IBT(356,IBX,0)),U,19)
Q IBR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCONS2 9908 printed Dec 13, 2024@02:18:27 Page 2
IBCONS2 ;ALB/CPM - NSC W/INSURANCE OUTPUT (CON'T) ;31-JAN-92
+1 ;;2.0;INTEGRATED BILLING;**19,36,54,66,91,99,108,120,142,174,155**;21-MAR-94
+2 ;
+3 ;MAP TO DGCRONS2
+4 ;
LOOP1 ; Compilation for both Inpatient Admisssion and Discharge reports.
+1 NEW DA,IBADM
KILL ^TMP($JOB,"PATIENT INCLUDE"),^TMP($JOB,"PATIENT EXCLUDE")
+2 DO DIV
+3 FOR I=(IBBEG-.0001):0
SET I=$ORDER(^DGPM(IBSUB,I))
if 'I!(I>(IBEND+.99))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM(IBSUB,I,DFN))
if 'DFN
QUIT
SET DA=+$ORDER(^(DFN,0))
Begin DoDot:2
+5 if IBINPT=2
SET DA=+$PIECE($GET(^DGPM(DA,0)),"^",14)
SET IBADM=+$GET(^DGPM(DA,0))
+6 SET PTF=$PIECE($GET(^DGPM(DA,0)),"^",16)
+7 SET IBADMVT=DA
+8 SET IBDV=+$PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(DA,0)),"^",6),0)),"^",11)
End DoDot:2
if PTF
DO PTF
IF $GET(IBDV)
DO PROC
KILL IBADMVT
End DoDot:1
+9 KILL ^TMP($JOB,"PATIENT INCLUDE"),^TMP($JOB,"PATIENT EXCLUDE")
+10 QUIT
+11 ;
+12 ;
LOOP2 ; Compilation for the Outpatient report
+1 NEW DFN,IBDTA,IBDV,IBVAL,IBFILTER,IBCBK,IBNO,IBOE,IBOE0,IBSTOP,IBOEZ,Y,Y0,IBQUERY2
+2 DO DIV
KILL ^TMP($JOB,"PATIENT INCLUDE"),^TMP($JOB,"PATIENT EXCLUDE")
+3 ;
+4 SET IBQUERY2=""
+5 SET IBVAL("BDT")=IBBEG
SET IBVAL("EDT")=IBEND+.99
+6 SET IBFILTER="I '$P(Y0,U,6)"
+7 SET IBCBK="D CALLBCK^IBCONS2(Y,Y0,.IBQUERY2)"
+8 KILL ^TMP("IBOEC",$JOB)
+9 DO SCAN^IBSDU("DATE/TIME",.IBVAL,IBFILTER,IBCBK,1)
KILL ^TMP("DIERR",$JOB)
+10 IF $GET(IBQUERY2)
DO CLOSE^IBSDU(IBQUERY2)
+11 ;
+12 ; Process stand-alone add/edits extracted
+13 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("IBOEC",$JOB,DFN))
if 'DFN
QUIT
IF $DATA(^DPT(DFN,0))
Begin DoDot:1
+14 SET IBDTA=0
FOR
SET IBDTA=$ORDER(^TMP("IBOEC",$JOB,DFN,IBDTA))
if 'IBDTA
QUIT
Begin DoDot:2
+15 KILL IBOE,IBSTOP,IBCOMB
+16 SET IBNO=1
+17 SET IBOEZ=0
FOR
SET IBOEZ=$ORDER(^TMP("IBOEC",$JOB,DFN,IBDTA,IBOEZ))
if 'IBOEZ
QUIT
SET IBOE0=$$SCE^IBSDU(IBOEZ,"",0)
Begin DoDot:3
+18 SET IBDV=$PIECE(IBOE0,U,11)
+19 if $LENGTH($GET(IBOE(IBNO)))+$LENGTH(IBOEZ)+1>200
SET IBNO=IBNO+1
+20 SET IBOE(IBNO)=$GET(IBOE(IBNO))_IBOEZ_U
IF '$GET(IBOE)
SET IBOE=+IBOE(1)
+21 SET Z=+$PIECE($GET(^DIC(40.7,+$PIECE(IBOE0,U,3),0)),U,2)
if Z
SET IBCOMB(Z)=$GET(IBCOMB(Z))+1
End DoDot:3
+22 if '$DATA(IBSTOP)
SET IBSTOP="Add/Edit Stop Code^"
+23 SET Z=0
FOR
SET Z=$ORDER(IBCOMB(Z))
if 'Z
QUIT
SET IBSTOP=IBSTOP_Z_$SELECT(IBCOMB(Z)=1:"",1:"(x"_IBCOMB(Z)_")")_U
+24 ;
+25 SET I=IBDTA
+26 ;All add/edit encounters for a patient/date on a single line
IF $GET(IBOE)
DO PROCO
End DoDot:2
End DoDot:1
+27 ;
+28 KILL ^TMP("IBOEC",$JOB),^TMP($JOB,"PATIENT INCLUDE"),^TMP($JOB,"PATIENT EXCLUDE")
+29 QUIT
+30 ;
CALLBCK(IBOE,IBOE0,IBQUERY2) ; Executed by scan call back logic to process encounters
+1 ; IBOE = encounter ien
+2 ; IBOE0 = 0-node of the encounter
+3 ;
+4 NEW DFN,I,IBDC,IBDS,IBDV,IBSTOP,IBT,Z
+5 ; non-billable visit data source
IF '$$BDSRC^IBEFUNC3($PIECE($GET(IBOE0),U,5))
QUIT
+6 ;
+7 SET IBT=$PIECE(IBOE0,U,8)
SET DFN=$PIECE(IBOE0,U,2)
SET IBDV=$PIECE(IBOE0,U,11)
SET (IBDS,IBDC)=""
+8 SET I=+IBOE0
+9 if 'I
QUIT
if DFN=""
QUIT
+10 IF IBT=1
Begin DoDot:1
+11 SET IBDC=+$PIECE(IBOE0,U,4)
+12 IF IBDV=""
SET IBDV=$PIECE($GET(^SC(IBDC,0)),U,15)
End DoDot:1
+13 ;
+14 IF IBT=3
Begin DoDot:1
+15 SET IBDS=$$DISND^IBSDU(IBOE,IBOE0)
+16 IF IBDV=""
SET IBDV=$PIECE(IBDS,U,4)
End DoDot:1
+17 ;
+18 if '$$VALID()
QUIT
+19 ;
+20 ; Screen to only include 1-3 originating process and
+21 ; for 1 or 2, include only those that have appt types indicating they
+22 ; are included on reports
+23 ;
+24 IF $SELECT(IBT<3:$$RPT^IBEFUNC($PIECE(IBOE0,U,10),+IBOE0),1:IBT=3)
Begin DoDot:1
+25 ; Extract add/edits to global so we can combine the data into one line (2 lines if RNB defined)
+26 ; Stand-alone Add/Edits
IF IBT=2
Begin DoDot:2
+27 IF VAUTD'=1
if '$DATA(VAUTD(+IBDV))
QUIT
+28 IF VAUTD=1
if 'IBDV
QUIT
+29 IF +$$RNBOE(IBOE)
SET ^TMP("IBOEC",$JOB,DFN,(IBOE0\1)_".",IBOE)=""
QUIT
+30 SET ^TMP("IBOEC",$JOB,DFN,IBOE0\1,IBOE)=""
End DoDot:2
QUIT
+31 ;
+32 ;Appointments
IF IBT=1
Begin DoDot:2
+33 IF IBDC
Begin DoDot:3
+34 SET X=$$CHILD(IBOE,IBOE0,.IBVAL,.IBSTOP,.IBQUERY2)
+35 SET IBSTOP="Clinic: "_$PIECE($GET(^SC(IBDC,0)),U)_$SELECT('X:"",1:" -- "_IBSTOP)
+36 SET I=+IBOE0
DO PROCO
End DoDot:3
End DoDot:2
QUIT
+37 ;
+38 ;Registration
IF IBT=3
Begin DoDot:2
+39 NEW X
+40 if '$$DISCT^IBEFUNC(IBOE,IBOE0)
QUIT
+41 SET X=$$CHILD(IBOE,IBOE0,.IBVAL,.IBSTOP,.IBQUERY2)
+42 SET IBSTOP="Registration: "_$PIECE($GET(^DIC(37,+$PIECE(IBDS,U,7),0)),U)_$SELECT('X:"",1:" -- "_IBSTOP)
+43 SET I=+IBOE0
DO PROCO
End DoDot:2
QUIT
End DoDot:1
+44 ;
+45 QUIT
+46 ;
CHILD(IBOE,IBOE0,IBVAL,IBSTOP,IBQUERY2) ;Find any child add/edits
+1 ; IBSTOP and IBQUERY2 are returned
+2 NEW IBVAL1,IBFILTER,IBCBK,IBCOMB,Z
+3 MERGE IBVAL1=IBVAL
+4 SET (IBFILTER,IBSTOP)=""
SET IBVAL1("DFN")=+$PIECE(IBOE0,U,2)
+5 SET IBCBK="I $S(Y=IBOE:1,1:$P(Y0,U,6)=IBOE),$P(Y0,U,3),$$RPT^IBEFUNC($P(Y0,U,10),+Y0) S Z=+$P($G(^DIC(40.7,+$P(Y0,U,3),0)),U,2) S:Z IBCOMB(Z)=$G(IBCOMB(Z))+1"
+6 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL1,IBFILTER,IBCBK,0,.IBQUERY2)
KILL ^TMP("DIERR",$JOB)
+7 SET Z=0
FOR
SET Z=$ORDER(IBCOMB(Z))
if 'Z
QUIT
SET IBSTOP=$SELECT(IBSTOP="":"Stop Codes^",1:IBSTOP)_Z_$SELECT(IBCOMB(Z)=1:"",1:"(x"_IBCOMB(Z)_")")_U
+8 QUIT (IBSTOP'="")
+9 ;
PROC ; -process each episode of care
+1 if '$$VALID()
QUIT
PROCO ; Entrypoint for outpatient loop2
+1 KILL IBRMARK
+2 ; -find tracking entry get reason not billable
IF '$GET(IBSC)
DO TRACK^IBCONS3
+3 ; stays with all SC moves not added to CT but on rpt w/RNB ** PATCH 66
IF +$GET(IBSC)
SET IBRMARK="{ALL MOVES SC}"
+4 ; -on billed or unbilled list
DO BILL
DO SET
+5 QUIT
+6 ;
VALID() ;
+1 NEW IBOK
+2 SET IBOK=0
+3 ; pat already excluded from select range ** PATCH 66
IF +$GET(IBSELRNG)
IF $DATA(^TMP($JOB,"PATIENT EXCLUDE",DFN))
GOTO VALIDQ
+4 ; patient in selected range ** PATCH 66
IF +$GET(IBSELRNG)
IF +$GET(IBSELRNG)<3
IF '$$PAT(DFN)
GOTO VALIDQ
+5 IF VAUTD'=1
if '$DATA(VAUTD(+IBDV))
GOTO VALIDQ
+6 IF VAUTD=1
if 'IBDV
GOTO VALIDQ
+7 ; -is patient a vet and have ins data
DO PTCHK
if 'IBFLAG
GOTO VALIDQ
+8 ; -is insurance valid for date of care
DO INS
if 'IBFLAG
GOTO VALIDQ
+9 ; patient ins is included in range ** PATCH 66
IF +$GET(IBSELRNG)=3
IF '$$PTINS(DFN)
GOTO VALIDQ
+10 SET IBOK=1
VALIDQ QUIT IBOK
+1 ;
INS SET IBFLAG=$$INSURED^IBCNS1(DFN,I)
+1 IF +IBFLAG
IF +IBINPT
IF '$$PTCOV^IBCNSU3(DFN,+I,"INPATIENT")
SET IBFLAG=0
+2 QUIT
+3 ;
PTCHK SET IBFLAG=0
IF $DATA(^DPT(+DFN,.312))
IF $GET(^("VET"))="Y"
SET IBFLAG=1
+1 ; Patch #36 - removes non-veteran eligibilities and inpatient visits
+2 IF 'IBINPT
Begin DoDot:1
+3 NEW IBTEMP,IBOE0
SET IBTEMP=$$SCE^IBSDU(+IBOE,13,0)
SET IBOE0=$$SCE^IBSDU(+IBOE)
+4 IF $PIECE($GET(^DIC(8,+IBTEMP,0)),U,5)="N"
SET IBFLAG=0
QUIT
+5 IF '$$APPTCT^IBEFUNC(IBOE0)
SET IBFLAG=0
QUIT
End DoDot:1
+6 QUIT
+7 ;
SET NEW DPT0,IBSUBSC2,IBSUBSC3,IBSUBSC4,IBSUBSC6
SET DPT0=$GET(^DPT(+DFN,0))
+1 SET IBSUBSC2=+IBDV
IF +$GET(IBSELCDV)
SET IBSUBSC2="COMBINED"
+2 SET IBSUBSC3=$SELECT(B]"":2,1:1)
+3 SET IBSUBSC4=$PIECE(DPT0,U,1)
IF +$GET(IBSELTRM)
SET IBSUBSC4=+$$TERMDG(DFN)
+4 SET IBSUBSC6=I
FOR IBSUBSC6=IBSUBSC6:.000001
if '$DATA(^TMP($JOB,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6))
QUIT
+5 SET ^TMP($JOB,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6)=B
+6 IF $DATA(IBSTOP)
IF '$DATA(^TMP($JOB,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6,1))
SET ^(1)=IBSTOP
+7 IF $GET(IBRMARK)'=""
SET ^TMP($JOB,IBSUBSC2,IBSUBSC3,IBSUBSC4,DFN,IBSUBSC6,2)=$GET(IBRMARK)
+8 KILL IBSTOP,IBRMARK
+9 QUIT
+10 ;
BILL ; Add to billed list if is insurance bill, not canceled
+1 ; if opt, date is in list, if inpt, admission date = event date
+2 ; ** PATCH 66 modified to include check for bill authorized status and add that to the stored TMP array
+3 ;
+4 SET B=""
SET I1=$SELECT(IBINPT=2:IBADM,IBINPT:I,1:I\1)
SET IBAUTH=2
NEW IB0
+5 ; -- the following line modified in patch 19 to check for only inpt. bills ($p(^(0),u,5)<3) are counted as bills,
+6 ; for when there is an outpatient bill with the same event date.
+7 IF IBINPT
IF $DATA(^DGCR(399,"C",DFN))
FOR M=0:0
SET M=$ORDER(^DGCR(399,"C",DFN,M))
if 'M
QUIT
Begin DoDot:1
+8 SET IB0=$GET(^DGCR(399,M,0))
+9 IF IB0'=""
IF $PIECE(IB0,"^",5)<3
IF $PIECE(IB0,"^",13)<7
IF $PIECE($PIECE(IB0,"^",3),".")=$PIECE(I1,".")
IF $PIECE(IB0,"^",11)="i"
SET B=B_M_"^"
IF $PIECE(IB0,"^",13)<2
SET IBAUTH=1
End DoDot:1
if $LENGTH(B)>200
QUIT
+10 ;
+11 IF 'IBINPT
IF $DATA(^DGCR(399,"AOPV",DFN,I1))
FOR M=0:0
SET M=$ORDER(^DGCR(399,"AOPV",DFN,I1,M))
if 'M
QUIT
Begin DoDot:1
+12 SET IB0=$GET(^DGCR(399,M,0))
+13 IF IB0'=""
IF $PIECE(IB0,"^",13)<7
IF $PIECE(IB0,"^",11)="i"
SET B=B_M_"^"
IF $PIECE(IB0,"^",13)<2
SET IBAUTH=1
End DoDot:1
if $LENGTH(B)>200
QUIT
+14 IF +B
SET B=IBAUTH_"^"_B
+15 QUIT
+16 ;
PTF ; if all movements are for sc condition then not billable
+1 ;
+2 SET IBSC=""
if '$DATA(^DGPT(+PTF))
QUIT
+3 SET IBMOV=0
FOR
SET IBMOV=$ORDER(^DGPT(PTF,"M",IBMOV))
if 'IBMOV
QUIT
SET IBSC=$PIECE($GET(^(IBMOV,0)),"^",18)
IF IBSC=2!(IBSC="")
QUIT
+4 SET IBSC=$SELECT(IBSC=2!(IBSC=""):0,1:1)
+5 QUIT
DIV ;adds the requested divisions to the report
+1 NEW IBDIV
IF +$GET(IBSELCDV)
SET ^TMP($JOB,"COMBINED")=""
QUIT
+2 IF VAUTD'=1
Begin DoDot:1
+3 SET IBDIV=""
FOR
SET IBDIV=$ORDER(VAUTD(IBDIV))
if 'IBDIV
QUIT
SET ^TMP($JOB,IBDIV)=""
End DoDot:1
+4 IF VAUTD=1
Begin DoDot:1
+5 SET IBDIV=""
FOR
SET IBDIV=$ORDER(^DG(40.8,IBDIV))
if IBDIV']""!(+IBDIV'=IBDIV)
QUIT
IF $PIECE($GET(^DG(40.8,IBDIV,0)),"^",1)]""
SET ^TMP($JOB,IBDIV)=""
End DoDot:1
+6 QUIT
+7 ;
PAT(DFN) ; true if patient is included in range requested ** PATCH 66
+1 NEW IBX,IBY
SET IBX=1
+2 IF $DATA(^TMP($JOB,"PATIENT INCLUDE",DFN))
SET IBX=1
GOTO PATQ
+3 IF $DATA(^TMP($JOB,"PATIENT EXCLUDE",DFN))
SET IBX=0
GOTO PATQ
+4 ;
+5 IF +$GET(IBSELRNG)=2
SET IBY=$$TERMDG(DFN)
Begin DoDot:1
+6 IF IBY<$GET(IBSELSR1)
SET IBX=0
+7 IF +$GET(IBSELSR2)
IF IBY>IBSELSR2
SET IBX=0
End DoDot:1
+8 ;
+9 IF +$GET(IBSELRNG)=1
SET IBY=$PIECE($GET(^DPT(+DFN,0)),U,1)
SET IBX=$$STGRNG(IBY)
+10 ;
+11 IF +IBX
SET ^TMP($JOB,"PATIENT INCLUDE",DFN)=""
+12 IF 'IBX
SET ^TMP($JOB,"PATIENT EXCLUDE",DFN)=""
PATQ QUIT IBX
+1 ;
PTINS(DFN) ; check if patients ins is within selected range ** PATCH 66
+1 NEW IBY,IBX,IBAR,IBI
SET IBX=1
+2 IF $DATA(^TMP($JOB,"PATIENT INCLUDE",DFN))
SET IBX=1
GOTO PTINSQ
+3 IF $DATA(^TMP($JOB,"PATIENT EXCLUDE",DFN))
SET IBX=0
GOTO PTINSQ
+4 ;
+5 IF $GET(IBSELRNG)=3
DO ALL^IBCNS1(DFN,"IBAR",1,IBBEG)
DO ALL^IBCNS1(DFN,"IBAR",1,IBEND)
SET IBX=0
+6 SET IBI=0
FOR
SET IBI=$ORDER(IBAR(IBI))
if 'IBI
QUIT
SET IBY=+$GET(IBAR(IBI,0))
SET IBY=$PIECE($GET(^DIC(36,+IBY,0)),U,1)
IF +$$STGRNG(IBY)
SET IBX=1
QUIT
+7 ;
+8 IF +IBX
SET ^TMP($JOB,"PATIENT INCLUDE",DFN)=""
+9 IF 'IBX
SET ^TMP($JOB,"PATIENT EXCLUDE",DFN)=""
PTINSQ QUIT IBX
+1 ;
STGRNG(STRNG) ; check if the string passed in is contained within the selected ASCII range ** PATCH 66
+1 NEW IBSB,IBSE,IBI,IBY,IBX
SET IBX=1
SET STRNG=$$ASCII($GET(STRNG))
+2 FOR IBI=1:1
SET IBSB=$PIECE($GET(IBSELSR1),",",IBI)
SET IBY=$PIECE(STRNG,",",IBI)
if 'IBSB
QUIT
if IBSB<IBY
QUIT
IF IBSB>IBY
SET IBX=0
QUIT
+3 FOR IBI=1:1
SET IBSE=$PIECE($GET(IBSELSR2),",",IBI)
SET IBY=$PIECE(STRNG,",",IBI)
if 'IBSE
QUIT
if IBSE>IBY
QUIT
IF IBSE<IBY
SET IBX=0
QUIT
+4 QUIT IBX
+5 ;
ASCII(STRNG) ; returns string in ASCII ** PATCH 66
+1 NEW IBI,IBX,IBY
SET IBX=""
+2 IF $GET(STRNG)'=""
FOR IBI=1:1
SET IBY=$EXTRACT(STRNG,IBI)
if IBY=""
QUIT
SET IBX=IBX_$ASCII(IBY)_","
if $LENGTH(IBX)>196
QUIT
+3 QUIT IBX
+4 ;
TERMDG(DFN) ; returns a patients terminal digit ** PATCH 66
+1 NEW TERMD,DPT0,SSN
SET TERMD=""
SET DPT0=$GET(^DPT(+DFN,0))
SET SSN=$PIECE(DPT0,"^",9)
+2 SET TERMD=$EXTRACT(SSN,8,9)_$EXTRACT(SSN,6,7)_$EXTRACT(SSN,4,5)_$EXTRACT(SSN,1,3)
+3 QUIT TERMD
+4 ;
RNBOE(IBOE) ; return a Reason Not Billable for the encounter if one can be found
+1 NEW IBX,IBR
SET IBR=""
IF +$GET(IBOE)
SET IBX=+$ORDER(^IBT(356,"ASCE",+IBOE,0))
IF +IBX
SET IBR=$PIECE($GET(^IBT(356,IBX,0)),U,19)
+2 QUIT IBR
