Routine: IBCEBUL

IBCEBUL ;ALB/TMP - 837 EDI SPECIAL BULLETINS PROCESSING ;19-SEP-96

 ;;2.0;INTEGRATED BILLING;**137,250,377**;21-MAR-94;Build 23

 ;;Per VHA Directive 2004-038, this routine should not be modified.

NOTSENT ; Check for batches in pending status (no confirmation from Austin)

 ;  from yesterday or before

 N XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBTYP

 K ^TMP($J,"IBNOTSENT")

 S (IBCT,IBI)=0

 F  S IBI=$O(^IBA(364.1,"ASTAT","P",IBI)) Q:'IBI  D

 . I $$BCHCHK(IBI) Q    ; Batch check function

 . S IBCT=IBCT+1

 . S IBTYP=$P($G(^IBA(364.1,IBI,0)),U,7)

 . I IBCT'>10,IBTYP'="" S ^TMP($J,"IBNOTSENT",IBTYP,IBI)=""

. Q

 I IBCT D

 .S IBT(1)="There are "_IBCT_" EDI batch(es) still pending Austin receipt "

 .S IBT(2)="for more than 1 day.  Please investigate why they have not yet been confirmed"

 .S IBT(3)="as being received by Austin."

 .S IBT(4)=" "

 .I IBCT>10 S IBT(5)="Since there were more than 10 batches found, please run the ",IBT(6)="  EDI BATCHES PENDING RECEIPT report to get a list of these batches."

 .I IBCT'>10 D

 ..S IBT(5)="      BATCH #      PENDING SINCE             MAIL MESSAGE #",IBT(6)="",$P(IBT(6),"-",76)="",IBT(6)="  "_IBT(6),IBE=6

 ..S IBTYP=""

 ..F  S IBTYP=$O(^TMP($J,"IBNOTSENT",IBTYP)) Q:IBTYP=""  D

 ...S Z=$$EXPAND^IBTRE(364.1,.07,IBTYP) S:Z="" Z="??"

 ...I $O(^TMP($J,"IBNOTSENT",IBTYP),-1)'="" S IBE=IBE+1,IBT(IBE)=" "

 ...S IBE=IBE+1,IBT(IBE)="  BATCH TYPE: "_Z

 ...S IBI=0 F  S IBI=$O(^TMP($J,"IBNOTSENT",IBTYP,IBI)) Q:'IBI  D

 ....S IBE=IBE+1,IB0=$G(^IBA(364.1,IBI,0)),IB1=$G(^(1))

 ....S IBT(IBE)="      "_$E($P(IB0,U)_$J("",10),1,10)_"   "_$E($$FMTE^XLFDT($P(IB1,U,6),1)_$J("",20),1,20)_"      "_$P(IB0,U,4),IBE=IBE+1,IBT(IBE)=$J("",8)_$E($P(IB0,U,8),1,72)

 .S XMSUBJ="EDI BATCHES WAITING AUSTIN RECEIPT FOR OVER 1 DAY",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")=""

 .D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)

 K ^TMP($J,"IBNOTSENT")

UPDBCH(BCHIEN) ; update the status of this batch to show A0:received in Austin

 NEW DIE,DA,DR

 S DIE=364.1,DA=+BCHIEN,DR=".02///A0"

 I $D(^IBA(DIE,DA,0)) D ^DIE

UPDBCHX ;

BCHCHK(BCHIEN) ; This function will check the EDI claims associated with this

 ; batch and determine if this batch has been received in Austin or not.

 ; ** This function is also called by routine IBCERP3 **

 ; Function value = 1 if we can determine that the batch was received in Austin, or

 ;                = 1 if there are no claims in this batch, or

 ;                = 1 if the batch is less than 24 hours old - too new to worry about

 ;                = 1 means don't display on report or MailMan message

 ; Function value = 0 if the batch has not yet been received in Austin

 ;                = 0 means we need to display batch on report and in MailMan message

 NEW IBEDI,IBOK,IBZ,IBIFN,IB0,AR,IBSECS

 S IBEDI=0,IBOK=1,BCHIEN=+$G(BCHIEN)

 ; if the batch transmission is still less than 24 hours old, skip this batch and get out

 S IBSECS=$$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^IBA(364.1,BCHIEN,1)),U,6),2)

 I IBSECS<86400 G BCHCHKX    ; # seconds in a day

 ; if no edi claims in this batch, update batch status and get out

 I '$O(^IBA(364,"C",BCHIEN,0)) D UPDBCH(BCHIEN) G BCHCHKX

 F  S IBEDI=$O(^IBA(364,"C",BCHIEN,IBEDI)) Q:'IBEDI  D  Q:'IBOK

 . S IBZ=$G(^IBA(364,IBEDI,0))

 . S IBIFN=+IBZ,IB0=$G(^DGCR(399,IBIFN,0))

 . I $P(IB0,U,13)=7 Q                    ; cancelled in IB

 . I $P(IBZ,U,3)'="P" Q                  ; edi claim status is not pending

 . S AR=$P($$BILL^RCJIBFN2(IBIFN),U,2)   ; AR status DBIA 1452

 . I $F(".22.26.39.","."_AR_".") Q       ; collected/closed or cancelled

. ;

 . ; if we get to this point, then we have found an EDI claim in this batch

 . ; that is not cancelled in IB, the EDI claim status is "P", and the

 . ; AR status is not collected/closed nor cancelled in AR.  So therefore

 . ; this claim didn't get to Austin, so the batch didn't get to Austin.

 . S IBOK=0

. Q

 ; If we find the batch has been received in Austin, then change the batch status.

 I IBOK D UPDBCH(BCHIEN)

BCHCHKX ;

 Q IBOK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEBUL   4125     printed  Mar 13, 2025@21:14:26                                                                                                                                                                                                     Page 2

IBCEBUL   ;ALB/TMP - 837 EDI SPECIAL BULLETINS PROCESSING ;19-SEP-96

 +1       ;;2.0;INTEGRATED BILLING;**137,250,377**;21-MAR-94;Build 23

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

NOTSENT   ; Check for batches in pending status (no confirmation from Austin)

 +1       ;  from yesterday or before

 +2        NEW XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBTYP

 +3        KILL ^TMP($JOB,"IBNOTSENT")

 +4        SET (IBCT,IBI)=0

 +5        FOR

               SET IBI=$ORDER(^IBA(364.1,"ASTAT","P",IBI))

               if 'IBI

                   QUIT

               Begin DoDot:1

 +6       ; Batch check function

                   IF $$BCHCHK(IBI)

                       QUIT

 +7                SET IBCT=IBCT+1

 +8                SET IBTYP=$PIECE($GET(^IBA(364.1,IBI,0)),U,7)

 +9                IF IBCT'>10

                       IF IBTYP'=""

                           SET ^TMP($JOB,"IBNOTSENT",IBTYP,IBI)=""

 +10               QUIT

               End DoDot:1

 +11      ;

 +12       IF IBCT

               Begin DoDot:1

 +13               SET IBT(1)="There are "_IBCT_" EDI batch(es) still pending Austin receipt "

 +14               SET IBT(2)="for more than 1 day.  Please investigate why they have not yet been confirmed"

 +15               SET IBT(3)="as being received by Austin."

 +16               SET IBT(4)=" "

 +17               IF IBCT>10

                       SET IBT(5)="Since there were more than 10 batches found, please run the "

                       SET IBT(6)="  EDI BATCHES PENDING RECEIPT report to get a list of these batches."

 +18               IF IBCT'>10

                       Begin DoDot:2

 +19                       SET IBT(5)="      BATCH #      PENDING SINCE             MAIL MESSAGE #"

                           SET IBT(6)=""

                           SET $PIECE(IBT(6),"-",76)=""

                           SET IBT(6)="  "_IBT(6)

                           SET IBE=6

 +20                       SET IBTYP=""

 +21                       FOR

                               SET IBTYP=$ORDER(^TMP($JOB,"IBNOTSENT",IBTYP))

                               if IBTYP=""

                                   QUIT

                               Begin DoDot:3

 +22                               SET Z=$$EXPAND^IBTRE(364.1,.07,IBTYP)

                                   if Z=""

                                       SET Z="??"

 +23                               IF $ORDER(^TMP($JOB,"IBNOTSENT",IBTYP),-1)'=""

                                       SET IBE=IBE+1

                                       SET IBT(IBE)=" "

 +24                               SET IBE=IBE+1

                                   SET IBT(IBE)="  BATCH TYPE: "_Z

 +25                               SET IBI=0

FOR

                                       SET IBI=$ORDER(^TMP($JOB,"IBNOTSENT",IBTYP,IBI))

                                       if 'IBI

                                           QUIT

                                       Begin DoDot:4

 +26                                       SET IBE=IBE+1

                                           SET IB0=$GET(^IBA(364.1,IBI,0))

                                           SET IB1=$GET(^(1))

 +27                                       SET IBT(IBE)="      "_$EXTRACT($PIECE(IB0,U)_$JUSTIFY("",10),1,10)_"   "_$EXTRACT($$FMTE^XLFDT($PIECE(IB1,U,6),1)_$JUSTIFY("",20),1,20)_"      "_$PIECE(IB0,U,4)

                                           SET IBE=IBE+1

                                           SET IBT(IBE)=$JUSTIFY("",8)_$EXTRACT($PIECE(IB0,U,8),1,72)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

 +28               SET XMSUBJ="EDI BATCHES WAITING AUSTIN RECEIPT FOR OVER 1 DAY"

                   SET XMBODY="IBT"

                   SET XMDUZ=""

                   SET XMTO("I:G.IB EDI")=""

 +29               DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)

               End DoDot:1

 +30       KILL ^TMP($JOB,"IBNOTSENT")

 +31       QUIT

 +32      ;

UPDBCH(BCHIEN) ; update the status of this batch to show A0:received in Austin

 +1        NEW DIE,DA,DR

 +2        SET DIE=364.1

           SET DA=+BCHIEN

           SET DR=".02///A0"

 +3        IF $DATA(^IBA(DIE,DA,0))

               DO ^DIE

UPDBCHX   ;

 +1        QUIT

 +2       ;

BCHCHK(BCHIEN) ; This function will check the EDI claims associated with this

 +1       ; batch and determine if this batch has been received in Austin or not.

 +2       ;

 +3       ; ** This function is also called by routine IBCERP3 **

 +4       ;

 +5       ; Function value = 1 if we can determine that the batch was received in Austin, or

 +6       ;                = 1 if there are no claims in this batch, or

 +7       ;                = 1 if the batch is less than 24 hours old - too new to worry about

 +8       ;                = 1 means don't display on report or MailMan message

 +9       ;

 +10      ; Function value = 0 if the batch has not yet been received in Austin

 +11      ;                = 0 means we need to display batch on report and in MailMan message

 +12      ;

 +13       NEW IBEDI,IBOK,IBZ,IBIFN,IB0,AR,IBSECS

 +14       SET IBEDI=0

           SET IBOK=1

           SET BCHIEN=+$GET(BCHIEN)

 +15      ;

 +16      ; if the batch transmission is still less than 24 hours old, skip this batch and get out

 +17       SET IBSECS=$$FMDIFF^XLFDT($$NOW^XLFDT,$PIECE($GET(^IBA(364.1,BCHIEN,1)),U,6),2)

 +18      ; # seconds in a day

           IF IBSECS<86400

               GOTO BCHCHKX

 +19      ;

 +20      ; if no edi claims in this batch, update batch status and get out

 +21       IF '$ORDER(^IBA(364,"C",BCHIEN,0))

               DO UPDBCH(BCHIEN)

               GOTO BCHCHKX

 +22      ;

 +23       FOR

               SET IBEDI=$ORDER(^IBA(364,"C",BCHIEN,IBEDI))

               if 'IBEDI

                   QUIT

               Begin DoDot:1

 +24               SET IBZ=$GET(^IBA(364,IBEDI,0))

 +25               SET IBIFN=+IBZ

                   SET IB0=$GET(^DGCR(399,IBIFN,0))

 +26      ; cancelled in IB

                   IF $PIECE(IB0,U,13)=7

                       QUIT

 +27      ; edi claim status is not pending

                   IF $PIECE(IBZ,U,3)'="P"

                       QUIT

 +28      ; AR status DBIA 1452

                   SET AR=$PIECE($$BILL^RCJIBFN2(IBIFN),U,2)

 +29      ; collected/closed or cancelled

                   IF $FIND(".22.26.39.","."_AR_".")

                       QUIT

 +30      ;

 +31      ; if we get to this point, then we have found an EDI claim in this batch

 +32      ; that is not cancelled in IB, the EDI claim status is "P", and the

 +33      ; AR status is not collected/closed nor cancelled in AR.  So therefore

 +34      ; this claim didn't get to Austin, so the batch didn't get to Austin.

 +35               SET IBOK=0

 +36               QUIT

               End DoDot:1

               if 'IBOK

                   QUIT

 +37      ;

 +38      ; If we find the batch has been received in Austin, then change the batch status.

 +39       IF IBOK

               DO UPDBCH(BCHIEN)

 +40      ;

BCHCHKX   ;

 +1        QUIT IBOK

 +2       ;

IBCEBUL.m