Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (14 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEBUL.m

    r628 r636  
    11IBCEBUL ;ALB/TMP - 837 EDI SPECIAL BULLETINS PROCESSING ;19-SEP-96
    2  ;;2.0;INTEGRATED BILLING;**137,250,377**;21-MAR-94;Build 23
    3  ;;Per VHA Directive 2004-038, this routine should not be modified.
     2 ;;2.0;INTEGRATED BILLING;**137,250**;21-MAR-94
    43 ;
    54NOTSENT ; Check for batches in pending status (no confirmation from Austin)
    65 ;  from yesterday or before
    7  N XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBTYP
     6 N XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBDTM
    87 K ^TMP($J,"IBNOTSENT")
     8 D NOW^%DTC S IBDTM=%
    99 S (IBCT,IBI)=0
    10  F  S IBI=$O(^IBA(364.1,"ASTAT","P",IBI)) Q:'IBI  D
    11  . I $$BCHCHK(IBI) Q    ; Batch check function
    12  . S IBCT=IBCT+1
    13  . S IBTYP=$P($G(^IBA(364.1,IBI,0)),U,7)
    14  . I IBCT'>10,IBTYP'="" S ^TMP($J,"IBNOTSENT",IBTYP,IBI)=""
    15  . Q
    16  ;
     10 F  S IBI=$O(^IBA(364.1,"ASTAT","P",IBI)) Q:'IBI  S IBTYP=$P($G(^IBA(364.1,IBI,0)),U,7),IBDAYS=(IBDTM-$P($G(^(1)),U,6)) I IBDAYS>1,IBDAYS'=IBDTM,$O(^IBA(364,"C",IBI,0)) D
     11 .S IBCT=IBCT+1,IBCT(+IBTYP)=$G(IBCT(+IBTYP))+1
     12 .I IBCT'>10 S ^TMP($J,"IBNOTSENT",IBTYP,IBI)=""
    1713 I IBCT D
    1814 .S IBT(1)="There are "_IBCT_" EDI batch(es) still pending Austin receipt "
     
    2016 .S IBT(3)="as being received by Austin."
    2117 .S IBT(4)=" "
    22  .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."
     18 .I IBCT>10 S IBT(5)="Since there were more than 10 batches found, please run the ",IBT(6)="  EDI BATCHES WAITING FOR AUSTIN RECEIPT OVER 1-DAY report to get a list of these batches."
    2319 .I IBCT'>10 D
    2420 ..S IBT(5)="      BATCH #      PENDING SINCE             MAIL MESSAGE #",IBT(6)="",$P(IBT(6),"-",76)="",IBT(6)="  "_IBT(6),IBE=6
     
    3228 ....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)
    3329 .S XMSUBJ="EDI BATCHES WAITING AUSTIN RECEIPT FOR OVER 1 DAY",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")=""
    34  .D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
     30 .D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
    3531 K ^TMP($J,"IBNOTSENT")
    3632 Q
    3733 ;
    38 UPDBCH(BCHIEN) ; update the status of this batch to show A0:received in Austin
    39  NEW DIE,DA,DR
    40  S DIE=364.1,DA=+BCHIEN,DR=".02///A0"
    41  I $D(^IBA(DIE,DA,0)) D ^DIE
    42 UPDBCHX ;
    43  Q
    44  ;
    45 BCHCHK(BCHIEN) ; This function will check the EDI claims associated with this
    46  ; batch and determine if this batch has been received in Austin or not.
    47  ;
    48  ; ** This function is also called by routine IBCERP3 **
    49  ;
    50  ; Function value = 1 if we can determine that the batch was received in Austin, or
    51  ;                = 1 if there are no claims in this batch, or
    52  ;                = 1 if the batch is less than 24 hours old - too new to worry about
    53  ;                = 1 means don't display on report or MailMan message
    54  ;
    55  ; Function value = 0 if the batch has not yet been received in Austin
    56  ;                = 0 means we need to display batch on report and in MailMan message
    57  ;
    58  NEW IBEDI,IBOK,IBZ,IBIFN,IB0,AR,IBSECS
    59  S IBEDI=0,IBOK=1,BCHIEN=+$G(BCHIEN)
    60  ;
    61  ; if the batch transmission is still less than 24 hours old, skip this batch and get out
    62  S IBSECS=$$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^IBA(364.1,BCHIEN,1)),U,6),2)
    63  I IBSECS<86400 G BCHCHKX    ; # seconds in a day
    64  ;
    65  ; if no edi claims in this batch, update batch status and get out
    66  I '$O(^IBA(364,"C",BCHIEN,0)) D UPDBCH(BCHIEN) G BCHCHKX
    67  ;
    68  F  S IBEDI=$O(^IBA(364,"C",BCHIEN,IBEDI)) Q:'IBEDI  D  Q:'IBOK
    69  . S IBZ=$G(^IBA(364,IBEDI,0))
    70  . S IBIFN=+IBZ,IB0=$G(^DGCR(399,IBIFN,0))
    71  . I $P(IB0,U,13)=7 Q                    ; cancelled in IB
    72  . I $P(IBZ,U,3)'="P" Q                  ; edi claim status is not pending
    73  . S AR=$P($$BILL^RCJIBFN2(IBIFN),U,2)   ; AR status DBIA 1452
    74  . I $F(".22.26.39.","."_AR_".") Q       ; collected/closed or cancelled
    75  . ;
    76  . ; if we get to this point, then we have found an EDI claim in this batch
    77  . ; that is not cancelled in IB, the EDI claim status is "P", and the
    78  . ; AR status is not collected/closed nor cancelled in AR.  So therefore
    79  . ; this claim didn't get to Austin, so the batch didn't get to Austin.
    80  . S IBOK=0
    81  . Q
    82  ;
    83  ; If we find the batch has been received in Austin, then change the batch status.
    84  I IBOK D UPDBCH(BCHIEN)
    85  ;
    86 BCHCHKX ;
    87  Q IBOK
    88  ;
Note: See TracChangeset for help on using the changeset viewer.