Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCE

IBCE.m

Go to the documentation of this file.
  1. IBCE ;ALB/TMP - 837 EDI TRANSMISSION UTILITIES/NIGHTLY JOB ;22-JAN-96
  1. ;;2.0;INTEGRATED BILLING;**137,283,296,371,623,659,641,650**;21-MAR-94;Build 21
  1. ;Per VA Directive 6402, this routine should not be modified
  1. EN ; Run all jobs needed for EDI processing nightly
  1. ; including transmit bills waiting for extract, batches not sent,
  1. N IBLAST,IBZ,IBZ0
  1. D NOTSENT^IBCEBUL
  1. D EN^IBCE837
  1. D EN^IBCEMPRG ; purge status messages from file 361
  1. D PURGE^IBCEPTU ; purge transmission detail and claims status data associated with test transmissions after 60 days
  1. S IBLAST=$G(^IBA(364.2,"ALAST")),^IBA(364.2,"ALAST")=$$NOW^XLFDT()
  1. ; Clean up ACOB xref in 364
  1. ;JWS;IB*2.0*650v6;if status = A0, don't prematurely close EDI entry, so users can see A0s on ECS report if not acknowledged receipt in FSC.
  1. S IBZ=0
  1. F S IBZ=$O(^IBA(364,"ACOB",IBZ)) Q:'IBZ S IBZ0=0 F S IBZ0=$O(^IBA(364,"ACOB",IBZ,IBZ0)) Q:'IBZ0 I '$$COBPOSS^IBCECOB(IBZ0) D
  1. . I $P($G(^IBA(364,IBZ0,0)),"^",3)="A0" Q
  1. . D UPDEDI^IBCEM(IBZ0,"N",1)
  1. . Q
  1. Q
  1. ;
  1. EN1 ; Manual entry point for transmitting EDI bills
  1. N DIR,X,Y,IBLAST,IBTASK,IBOPTX,DTOUT,DUOUT
  1. I '$$MGCHK(1) G EN1Q
  1. S DIR("A")="Select transmit option: ",DIR("B")="S",DIR(0)="SAM^A:Transmit (A)LL bills in READY FOR EXTRACT status;S:Transmit only (S)ELECTED bills"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) G EN1Q
  1. S IBOPTX=Y
  1. I Y="A" D G EN1Q
  1. . S DIR("A",1)="This option will run a job to transmit ALL bills ready for EDI transmission"
  1. . S DIR("A",2)="This option's last scheduled run was "_$$FMTE^XLFDT($G(^IBA(364.2,"ALAST")),2)
  1. . S DIR("A",3)=" "
  1. . S DIR("A")="Are you absolutely sure this is what you want to do? "
  1. . S DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
  1. . Q:'Y
  1. . S DIR(0)="YA",DIR("A",1)=" "
  1. . S DIR("A",2)="Transmission of ALL bills will be run now"
  1. . S DIR("A")="Is this OK? ",DIR("B")="NO"
  1. . D ^DIR K DIR
  1. . Q:'Y
  1. . D EN1^IBCE837B(.IBTASK)
  1. . I $G(IBTASK) D
  1. .. S DIR("A",1)="Task # for this job is: "_IBTASK
  1. . E D
  1. .. I $G(IBTASK)'="" S DIR("A",1)="Error encountered in tasking job - check IRM for reported errors"
  1. .. S DIR(0)="EA",DIR("A")=" Press RETURN to continue " W !! D ^DIR K DIR
  1. I IBOPTX="S" D SUB1^IBCEM03 G EN1Q
  1. EN1Q Q
  1. ;
  1. RESUB(IB364,IBRESULT) ; Manually resubmit bill for transmission (ien file 364 = IB364)
  1. ; added new parameter IBRESULT to see the result of calling this tag
  1. ; set to 0 initially and 1 if successful
  1. ; parameter is needed by IBCECSA4 calling routine
  1. N DIR,X,Y,IBBTCH,DTOUT,DUOUT,IBIFN,NEW364,IBC364
  1. S IBRESULT=0 ;WCJ;IB641
  1. I '$$MGCHK(1) G RESUBQ
  1. S IBIFN=+$P($G(^IBA(364,+$G(IB364),0)),U,1) I 'IBIFN G RESUBQ
  1. S IBBTCH=""
  1. W ! S DIR(0)="SA^I:IMMEDIATE TRANSMIT;L:TRANSMIT LATER WITH REST OF READY FOR EXTRACT BILLS",DIR("A")="TRANSMIT (I)MMEDIATELY OR (L)ATER?: ",DIR("B")="L"
  1. S DIR("?",1)="IF YOU CHOOSE TO TRANSMIT IMMEDIATELY, THE BILL'S DATA WILL BE BATCHED BY",DIR("?",2)=" ITSELF AND SENT OUT IMMEDIATELY. IF YOU CHOOSE TO TRANSMIT LATER, THE"
  1. S DIR("?",3)=" BILL'S TRANSMISSION STATUS WILL BE RESET TO 'READY FOR EXTRACT' AND THE BILL'S",DIR("?",4)=" DATA WILL BE EXTRACTED THE NEXT TIME A GENERAL TRANSMISSION OF YOUR BILLS",DIR("?")=" IN READY TO EXTRACT STATUS OCCURS"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) G RESUBQ
  1. ;
  1. ; immediate retransmission of claim
  1. I Y="I" D G RESUBQ
  1. . ;JWS;IB*2.0*650v4;attempt to prevent duplicates
  1. . S IBC364=$$LAST364^IBCEF4(IBIFN)
  1. . I IB364'=IBC364,$P($G(^IBA(364,IBC364,0)),U,3)="X"!($D(^IBA(364,"AC",1,IBC364))) D Q
  1. .. S DIR("A",1)="This Claim is already awaiting extract for retransmission.",DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. .. Q
  1. . I $P($G(^IBA(364,IB364,0)),U,3)="X"!($D(^IBA(364,"AC",1,IB364))) D Q
  1. .. S DIR("A",1)="This Claim is already awaiting extract for retransmission.",DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. .. Q
  1. . ;JWS;IB*2.0*641v9;added 4th parameter passing 1 to indicate 364, field .09 set = 1; not implemented but leaving for knowledge
  1. . S NEW364=$$ADDTBILL^IBCB1(IBIFN) ; Add a new transmission record
  1. . I '$P(NEW364,U,3) D Q
  1. .. S DIR("A",1)="FAILED TO ADD A NEW EDI TRANSMISSION",DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. .. Q
  1. . ;
  1. . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J)
  1. . S ^TMP("IBONE",$J,+NEW364)="",^TMP("IBONE",$J)=0,^TMP("IBSELX",$J)=""
  1. . ;JWS;IB*2.0*641v6;issue with resubmit of claim, batch # not generated until submitted
  1. . ; ;in FHIR, transaction does not get transmitted immediately
  1. . I $$GET1^DIQ(350.9,"1,",8.21,"I") S ^TMP("IBRESUBMIT",$J,$P(NEW364,U))=""
  1. . D ONE^IBCE837
  1. . S IBBTCH=$O(^TMP("IBCE-BATCH",$J,0)) ; external batch#
  1. . I IBBTCH'="" S IBBTCH=+$G(^TMP("IBCE-BATCH",$J,IBBTCH)) ; internal batch#
  1. . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J)
  1. . ;
  1. . ;JWS;IB*2.0*641v6;if FHIR is on, no Batch # will be available
  1. . I 'IBBTCH,'$$GET1^DIQ(350.9,"1,",8.21,"I") D
  1. .. S DIR("A",1)="BILL NOT RESUBMITTED - CHECK ALERTS/MAIL FOR DETAILS"
  1. . E D
  1. .. ;JWS;IB*2.0*623v24;add setting resubmission flag
  1. .. ;;D SETSUB^IBCE837I($P(NEW364,U),1)
  1. .. N DIE,DR,DA
  1. .. D UPDEDI^IBCEM(IB364,"R") ; update EDI files for old transmission
  1. .. ;JWS;IB*2.0*641v6;837 FHIR just indicate submitted
  1. .. I $$GET1^DIQ(350.9,"1,",8.21,"I") D Q
  1. ... S DIR("A",1)="BILL placed onto 837 FHIR Transaction list. It will be submitted shortly..."
  1. .. S DIE="^IBA(364,",DR=".06////"_+IBBTCH,DA=IB364 D ^DIE
  1. .. S DIR("A",1)="BILL RESUBMITTED IN BATCH #"_$P($G(^IBA(364.1,+IBBTCH,0)),U,1)
  1. .. S IBRESULT=1 ;WCJ;IB641;successful
  1. . S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. . Q
  1. ;
  1. ; Later retransmission of claim
  1. ;JWS;IB*2.0*650v4;attempt to prevent duplicates
  1. S IBC364=$$LAST364^IBCEF4(IBIFN)
  1. I IB364'=IBC364,$P($G(^IBA(364,IBC364,0)),U,3)="X"!($D(^IBA(364,"AC",1,IBC364))) D Q
  1. . S DIR("A",1)="This Claim is already awaiting extract for retransmission.",DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. . Q
  1. I $P($G(^IBA(364,IB364,0)),U,3)="X"!($D(^IBA(364,"AC",1,IB364))) D Q
  1. . S DIR("A",1)="This Claim is already awaiting extract for retransmission.",DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. . Q
  1. D UPDEDI^IBCEM(IB364,"R") ; update EDI files for old transmission record
  1. S Y=$$ADDTBILL^IBCB1(IBIFN) ; Add a new transmission record
  1. ;JWS;IB*2.0*623v24;add setting resubmission flag
  1. D SETSUB^IBCE837I(+Y,1)
  1. S DIR("A",1)="BILL'S TRANSMISSION STATUS RESET TO 'READY TO EXTRACT'"
  1. S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR
  1. S IBRESULT=1 ;WCJ;IB641;successful
  1. ;
  1. RESUBQ Q
  1. ;
  1. MGCHK(DSP) ; Returns 1 if mail group IB EDI has at least 1 local member,
  1. ; 0 if none found
  1. ; DSP = flag that if =1, displays error message
  1. N IB
  1. S IB=$$GOTLOCAL^XMXAPIG("IB EDI")
  1. I 'IB,$G(DSP) D
  1. . ; No local members in mail group for EDI messages
  1. . S DIR("A",1)="YOU MUST HAVE AT LEAST 1 MEMBER IN THE 'IB EDI' MAIL GROUP TO TRANSMIT A BILL",DIR("A")="PRESS RETURN TO CONTINUE "
  1. . S DIR(0)="EA" D ^DIR K DIR
  1. Q IB
  1. ;