IBCONS2.m

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 ---IBCONS2   9908     printed  Apr 23, 2025@18:33                                                                                                                                                                                                        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