IBCD ;ALB/ARH - AUTOMATED BILLER ;8/6/93
 ;;2.0;INTEGRATED BILLING;**312,554,592**;21-MAR-94;Build 58
 ;Per VA Directive 6402, this routine should not be modified.
 ;
 ;This routine is the begining of the auto biller.  No variables are required on entry.  It is be called by the
 ;IB nightly job routine IBAMTC.  It first checks to see if it should run based on the auto biller frequency
 ;site parameter.  It then gathers the Claims Tracking events with an EABD into a temporary file by patient,
 ;event type, and episode date.  This temporary file ("IBACAB") is then used to sort the events into groups
 ;that should be added to individual bills based on the individual event type billing cycle parameters.  This
 ;second temporary file is then used to create the actual bills in IBCD1-2.
 ;
EN ;begin process of finding and creating bills
 ;determine if auto biller should run, check site parameters (350.9,7.01-7.02)
 N IBSWINFO,IBPFSS S IBSWINFO=$$SWSTAT^IBBAPI()            ;IB*2.0*312
 ;
 ;add nightly process for Non VA Care (IB*2.0*554) Currently disabled
 ;D NRUN^IBFBNP1 
 ; End changes by (IB*2.0*554)
 S IBPAR7=$G(^IBE(350.9,1,7)) G:'$P(IBPAR7,U,1) EXIT
 I +IBPAR7,+$P(IBPAR7,U,2),$$FMADD^XLFDT(+$P(IBPAR7,U,2),+IBPAR7)>DT G EXIT
 S IBAUTO=1
 ;begin search for events to bill, create array of events by patient
 ;^TMP("IBCAB",$J, PATIENT, EVENT TYPE, EPISODE DATE, EVENT IFN)=""
 ;adds all events in Claims Tracking that have an EABD not after today
 S IBDFN=0 F  S IBDFN=$O(^IBT(356,"ATOBIL",IBDFN)) Q:'IBDFN  D
 . S IBTYP=0 F  S IBTYP=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP)) Q:'IBTYP  D
 .. S IBEABD=0 F  S IBEABD=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD)) Q:'IBEABD!(IBEABD>DT)  D
 ... S IBTRN=0 F  S IBTRN=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD,IBTRN)) Q:'IBTRN  D
 .... S IBX=$$EVBILL^IBCU81(IBTRN) I 'IBX!(IBX>DT) D TEABD(IBTRN,+IBX) D:$P(IBX,U,2)'="" TERR(IBTRN,0,$P(IBX,U,2)) Q
 .... S IBX=$$EVNTCHK^IBCU82(IBTRN) I +IBX D TEABD(IBTRN,0) D TERR(IBTRN,0,$P(IBX,U,2)) Q
 .... S IBTRND=$G(^IBT(356,IBTRN,0))
 .... I +IBSWINFO D  Q:IBPFSS                               ;IB*2.0*312
 ..... S IBPFSS=1                                         ;IB*2.0*312
 ..... ; Do NOT PROCESS on VistA if DT>=Switch Eff Date   ;CCR-930
 ..... I ($P(IBTRND,"^",6)+1)>$P(IBSWINFO,"^",2) Q        ;IB*2.0*312
 ..... I $P($G(^DPT(IBDFN,.1)),"^")'="" Q                 ;IB*2.0*312
 ..... Q:$$CHKDIS()                                       ;CCR-1081
 ..... S IBPFSS=0     ;Before EffDt & Discharged          ;IB*2.0*312
 .... ;
 .... ;JWS;IB*2.0*592;US1109; IA# 2056 ;If Dental and Plan Coverage Limitation is NO skip, or DO NOT PROCESS Flag set in site parameters
 .... I $F($$GET1^DIQ(9000010,$P(IBTRND,"^",3)_",",.08),"DENTAL"),'$$PTCOV^IBCNSU3(IBDFN,+$P(IBTRND,U,6),"DENTAL")!(+$P(^IBE(350.9,1,8),U,20)=0) Q
 .... S ^TMP("IBCAB",$J,IBDFN,IBTYP,+$P(IBTRND,U,6),IBTRN)=""
 K IBDFN,IBTYP,IBEABD,IBTRN,IBTRND,IBX
 ;
 I $D(^TMP("IBCAB",$J)) D ^IBCD1 ; consolidate events into bills, create bills
 D ^IBCDC ; set comments into file
 S DIE="^IBE(350.9,",DA=1,DR="7.02////"_DT D ^DIE ;reset last date auto biller run
 K ^TMP("IBCAB",$J),^TMP("IBEABD",$J),^TMP("IBCE",$J),^TMP("IBILL",$J)
 F IBX=1:1:10 K ^TMP(("IBC"_IBX),$J)
EXIT K IBX,IBPAR7,DIE,DA,DR,IBAUTO,IBBS,IBSC,IBT
 Q
CHKDIS() ; Returns 1 if discharge was on or after effective date   ;CCR-1081
 N IBADMLNK,IBDISLNK
 S IBADMLNK=$P(IBTRND,"^",5) G:'IBADMLNK CHKDISQ
 S IBDISLNK=$P($G(^DGPM(IBADMLNK,0)),"^",17) G:'IBDISLNK CHKDISQ
 ;
 I (^DGPM(IBDISLNK,0)+1)>$P(IBSWINFO,"^",2) Q 1
CHKDISQ Q 0
 ;
TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
 S IBDT=+$G(IBDT),^TMP("IBEABD",$J,TRN,+IBDT)=""
 Q
TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
 N X S TRN=+$G(TRN),IFN=+$G(IFN),X=+$G(^TMP("IBCE",$J,DT,TRN,IFN))+1
 S ^TMP("IBCE",$J,DT,TRN,IFN,X)=$G(ER),^TMP("IBCE",$J,DT,TRN,IFN)=X
 Q
TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
 I '$D(^IBT(356,+$G(TRN),0))!('$D(^DGCR(399,+$G(IFN),0))) Q
 S ^TMP("IBILL",$J,TRN,IFN)=""
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCD   4204     printed  Sep 23, 2025@19:45:25                                                                                                                                                                                                        Page 2
IBCD      ;ALB/ARH - AUTOMATED BILLER ;8/6/93
 +1       ;;2.0;INTEGRATED BILLING;**312,554,592**;21-MAR-94;Build 58
 +2       ;Per VA Directive 6402, this routine should not be modified.
 +3       ;
 +4       ;This routine is the begining of the auto biller.  No variables are required on entry.  It is be called by the
 +5       ;IB nightly job routine IBAMTC.  It first checks to see if it should run based on the auto biller frequency
 +6       ;site parameter.  It then gathers the Claims Tracking events with an EABD into a temporary file by patient,
 +7       ;event type, and episode date.  This temporary file ("IBACAB") is then used to sort the events into groups
 +8       ;that should be added to individual bills based on the individual event type billing cycle parameters.  This
 +9       ;second temporary file is then used to create the actual bills in IBCD1-2.
 +10      ;
EN        ;begin process of finding and creating bills
 +1       ;determine if auto biller should run, check site parameters (350.9,7.01-7.02)
 +2       ;IB*2.0*312
           NEW IBSWINFO,IBPFSS
           SET IBSWINFO=$$SWSTAT^IBBAPI()
 +3       ;
 +4       ;add nightly process for Non VA Care (IB*2.0*554) Currently disabled
 +5       ;D NRUN^IBFBNP1 
 +6       ; End changes by (IB*2.0*554)
 +7        SET IBPAR7=$GET(^IBE(350.9,1,7))
           if '$PIECE(IBPAR7,U,1)
               GOTO EXIT
 +8        IF +IBPAR7
               IF +$PIECE(IBPAR7,U,2)
                   IF $$FMADD^XLFDT(+$PIECE(IBPAR7,U,2),+IBPAR7)>DT
                       GOTO EXIT
 +9        SET IBAUTO=1
 +10      ;begin search for events to bill, create array of events by patient
 +11      ;^TMP("IBCAB",$J, PATIENT, EVENT TYPE, EPISODE DATE, EVENT IFN)=""
 +12      ;adds all events in Claims Tracking that have an EABD not after today
 +13       SET IBDFN=0
           FOR 
               SET IBDFN=$ORDER(^IBT(356,"ATOBIL",IBDFN))
               if 'IBDFN
                   QUIT 
               Begin DoDot:1
 +14               SET IBTYP=0
                   FOR 
                       SET IBTYP=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP))
                       if 'IBTYP
                           QUIT 
                       Begin DoDot:2
 +15                       SET IBEABD=0
                           FOR 
                               SET IBEABD=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD))
                               if 'IBEABD!(IBEABD>DT)
                                   QUIT 
                               Begin DoDot:3
 +16                               SET IBTRN=0
                                   FOR 
                                       SET IBTRN=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD,IBTRN))
                                       if 'IBTRN
                                           QUIT 
                                       Begin DoDot:4
 +17                                       SET IBX=$$EVBILL^IBCU81(IBTRN)
                                           IF 'IBX!(IBX>DT)
                                               DO TEABD(IBTRN,+IBX)
                                               if $PIECE(IBX,U,2)'=""
                                                   DO TERR(IBTRN,0,$PIECE(IBX,U,2))
                                               QUIT 
 +18                                       SET IBX=$$EVNTCHK^IBCU82(IBTRN)
                                           IF +IBX
                                               DO TEABD(IBTRN,0)
                                               DO TERR(IBTRN,0,$PIECE(IBX,U,2))
                                               QUIT 
 +19                                       SET IBTRND=$GET(^IBT(356,IBTRN,0))
 +20      ;IB*2.0*312
                                           IF +IBSWINFO
                                               Begin DoDot:5
 +21      ;IB*2.0*312
                                                   SET IBPFSS=1
 +22      ; Do NOT PROCESS on VistA if DT>=Switch Eff Date   ;CCR-930
 +23      ;IB*2.0*312
                                                   IF ($PIECE(IBTRND,"^",6)+1)>$PIECE(IBSWINFO,"^",2)
                                                       QUIT 
 +24      ;IB*2.0*312
                                                   IF $PIECE($GET(^DPT(IBDFN,.1)),"^")'=""
                                                       QUIT 
 +25      ;CCR-1081
                                                   if $$CHKDIS()
                                                       QUIT 
 +26      ;Before EffDt & Discharged          ;IB*2.0*312
                                                   SET IBPFSS=0
                                               End DoDot:5
                                               if IBPFSS
                                                   QUIT 
 +27      ;
 +28      ;JWS;IB*2.0*592;US1109; IA# 2056 ;If Dental and Plan Coverage Limitation is NO skip, or DO NOT PROCESS Flag set in site parameters
 +29                                       IF $FIND($$GET1^DIQ(9000010,$PIECE(IBTRND,"^",3)_",",.08),"DENTAL")
                                               IF '$$PTCOV^IBCNSU3(IBDFN,+$PIECE(IBTRND,U,6),"DENTAL")!(+$PIECE(^IBE(350.9,1,8),U,20)=0)
                                                   QUIT 
 +30                                       SET ^TMP("IBCAB",$JOB,IBDFN,IBTYP,+$PIECE(IBTRND,U,6),IBTRN)=""
                                       End DoDot:4
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +31       KILL IBDFN,IBTYP,IBEABD,IBTRN,IBTRND,IBX
 +32      ;
 +33      ; consolidate events into bills, create bills
           IF $DATA(^TMP("IBCAB",$JOB))
               DO ^IBCD1
 +34      ; set comments into file
           DO ^IBCDC
 +35      ;reset last date auto biller run
           SET DIE="^IBE(350.9,"
           SET DA=1
           SET DR="7.02////"_DT
           DO ^DIE
 +36       KILL ^TMP("IBCAB",$JOB),^TMP("IBEABD",$JOB),^TMP("IBCE",$JOB),^TMP("IBILL",$JOB)
 +37       FOR IBX=1:1:10
               KILL ^TMP(("IBC"_IBX),$JOB)
EXIT       KILL IBX,IBPAR7,DIE,DA,DR,IBAUTO,IBBS,IBSC,IBT
 +1        QUIT 
CHKDIS()  ; Returns 1 if discharge was on or after effective date   ;CCR-1081
 +1        NEW IBADMLNK,IBDISLNK
 +2        SET IBADMLNK=$PIECE(IBTRND,"^",5)
           if 'IBADMLNK
               GOTO CHKDISQ
 +3        SET IBDISLNK=$PIECE($GET(^DGPM(IBADMLNK,0)),"^",17)
           if 'IBDISLNK
               GOTO CHKDISQ
 +4       ;
 +5        IF (^DGPM(IBDISLNK,0)+1)>$PIECE(IBSWINFO,"^",2)
               QUIT 1
CHKDISQ    QUIT 0
 +1       ;
TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
 +1        SET IBDT=+$GET(IBDT)
           SET ^TMP("IBEABD",$JOB,TRN,+IBDT)=""
 +2        QUIT 
TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
 +1        NEW X
           SET TRN=+$GET(TRN)
           SET IFN=+$GET(IFN)
           SET X=+$GET(^TMP("IBCE",$JOB,DT,TRN,IFN))+1
 +2        SET ^TMP("IBCE",$JOB,DT,TRN,IFN,X)=$GET(ER)
           SET ^TMP("IBCE",$JOB,DT,TRN,IFN)=X
 +3        QUIT 
TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
 +1        IF '$DATA(^IBT(356,+$GET(TRN),0))!('$DATA(^DGCR(399,+$GET(IFN),0)))
               QUIT 
 +2        SET ^TMP("IBILL",$JOB,TRN,IFN)=""
 +3        QUIT 
 +4       ;