- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEBUL.m
r613 r623 1 IBCEBUL ;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. 4 ; 5 NOTSENT ; Check for batches in pending status (no confirmation from Austin) 6 ; from yesterday or before 7 N XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBTYP 8 K ^TMP($J,"IBNOTSENT") 9 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 ; 17 I IBCT D 18 .S IBT(1)="There are "_IBCT_" EDI batch(es) still pending Austin receipt " 19 .S IBT(2)="for more than 1 day. Please investigate why they have not yet been confirmed" 20 .S IBT(3)="as being received by Austin." 21 .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." 23 .I IBCT'>10 D 24 ..S IBT(5)=" BATCH # PENDING SINCE MAIL MESSAGE #",IBT(6)="",$P(IBT(6),"-",76)="",IBT(6)=" "_IBT(6),IBE=6 25 ..S IBTYP="" 26 ..F S IBTYP=$O(^TMP($J,"IBNOTSENT",IBTYP)) Q:IBTYP="" D 27 ...S Z=$$EXPAND^IBTRE(364.1,.07,IBTYP) S:Z="" Z="??" 28 ...I $O(^TMP($J,"IBNOTSENT",IBTYP),-1)'="" S IBE=IBE+1,IBT(IBE)=" " 29 ...S IBE=IBE+1,IBT(IBE)=" BATCH TYPE: "_Z 30 ...S IBI=0 F S IBI=$O(^TMP($J,"IBNOTSENT",IBTYP,IBI)) Q:'IBI D 31 ....S IBE=IBE+1,IB0=$G(^IBA(364.1,IBI,0)),IB1=$G(^(1)) 32 ....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) 33 .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) 35 K ^TMP($J,"IBNOTSENT") 36 Q 37 ; 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 ; 1 IBCEBUL ;ALB/TMP - 837 EDI SPECIAL BULLETINS PROCESSING ;19-SEP-96 2 ;;2.0;INTEGRATED BILLING;**137,250**;21-MAR-94 3 ; 4 NOTSENT ; Check for batches in pending status (no confirmation from Austin) 5 ; from yesterday or before 6 N XMTO,XMSUBJ,XMBODY,XMDUZ,IBT,IB,IBE,IBCT,IBI,IB0,IB1,Z,IBDTM 7 K ^TMP($J,"IBNOTSENT") 8 D NOW^%DTC S IBDTM=% 9 S (IBCT,IBI)=0 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)="" 13 I IBCT D 14 .S IBT(1)="There are "_IBCT_" EDI batch(es) still pending Austin receipt " 15 .S IBT(2)="for more than 1 day. Please investigate why they have not yet been confirmed" 16 .S IBT(3)="as being received by Austin." 17 .S IBT(4)=" " 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." 19 .I IBCT'>10 D 20 ..S IBT(5)=" BATCH # PENDING SINCE MAIL MESSAGE #",IBT(6)="",$P(IBT(6),"-",76)="",IBT(6)=" "_IBT(6),IBE=6 21 ..S IBTYP="" 22 ..F S IBTYP=$O(^TMP($J,"IBNOTSENT",IBTYP)) Q:IBTYP="" D 23 ...S Z=$$EXPAND^IBTRE(364.1,.07,IBTYP) S:Z="" Z="??" 24 ...I $O(^TMP($J,"IBNOTSENT",IBTYP),-1)'="" S IBE=IBE+1,IBT(IBE)=" " 25 ...S IBE=IBE+1,IBT(IBE)=" BATCH TYPE: "_Z 26 ...S IBI=0 F S IBI=$O(^TMP($J,"IBNOTSENT",IBTYP,IBI)) Q:'IBI D 27 ....S IBE=IBE+1,IB0=$G(^IBA(364.1,IBI,0)),IB1=$G(^(1)) 28 ....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) 29 .S XMSUBJ="EDI BATCHES WAITING AUSTIN RECEIPT FOR OVER 1 DAY",XMBODY="IBT",XMDUZ="",XMTO("I:G.IB EDI")="" 30 .D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ) 31 K ^TMP($J,"IBNOTSENT") 32 Q 33 ;
Note:
See TracChangeset
for help on using the changeset viewer.
