- 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/IBCE.m
r613 r623 1 IBCE ;ALB/TMP - 837 EDI TRANSMISSION UTILITIES/NIGHTLY JOB ;22-JAN-96 2 ;;2.0;INTEGRATED BILLING;**137,283,296,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 EN ; Run all jobs needed for EDI processing nightly 5 ; including transmit bills waiting for extract, batches not sent, 6 N IBLAST,IBZ,IBZ0 7 D NOTSENT^IBCEBUL 8 D EN^IBCE837 9 D EN^IBCEMPRG ; purge status messages from file 361 10 D PURGE^IBCEPTU ; purge transmission detail and claims status data associated with test transmissions after 60 days 11 S IBLAST=$G(^IBA(364.2,"ALAST")),^IBA(364.2,"ALAST")=$$NOW^XLFDT() 12 ; Clean up ACOB xref in 364 13 S IBZ=0 14 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 UPDEDI^IBCEM(IBZ0,"N",1) 15 Q 16 ; 17 EN1 ; Manual entry point for transmitting EDI bills 18 N DIR,X,Y,IBLAST,IBTASK,IBOPTX,DTOUT,DUOUT 19 I '$$MGCHK(1) G EN1Q 20 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" 21 D ^DIR K DIR 22 I $D(DTOUT)!$D(DUOUT) G EN1Q 23 S IBOPTX=Y 24 I Y="A" D G EN1Q 25 . S DIR("A",1)="This option will run a job to transmit ALL bills ready for EDI transmission" 26 . S DIR("A",2)="This option's last scheduled run was "_$$FMTE^XLFDT($G(^IBA(364.2,"ALAST")),2) 27 . S DIR("A",3)=" " 28 . S DIR("A")="Are you absolutely sure this is what you want to do? " 29 . S DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR 30 . Q:'Y 31 . S DIR(0)="YA",DIR("A",1)=" " 32 . S DIR("A",2)="Transmission of ALL bills will be run now" 33 . S DIR("A")="Is this OK? ",DIR("B")="NO" 34 . D ^DIR K DIR 35 . Q:'Y 36 . D EN1^IBCE837B(.IBTASK) 37 . I $G(IBTASK) D 38 .. S DIR("A",1)="Task # for this job is: "_IBTASK 39 . E D 40 .. I $G(IBTASK)'="" S DIR("A",1)="Error encountered in tasking job - check IRM for reported errors" 41 .. S DIR(0)="EA",DIR("A")=" Press RETURN to continue " W !! D ^DIR K DIR 42 I IBOPTX="S" D SUB1^IBCEM03 G EN1Q 43 EN1Q Q 44 ; 45 RESUB(IB364) ; Manually resubmit bill for transmission (ien file 364 = IB364) 46 N DIR,X,Y,IBBTCH,DTOUT,DUOUT,IBIFN,NEW364 47 I '$$MGCHK(1) G RESUBQ 48 S IBIFN=+$P($G(^IBA(364,+$G(IB364),0)),U,1) I 'IBIFN G RESUBQ 49 S IBBTCH="" 50 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" 51 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" 52 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" 53 D ^DIR K DIR 54 I $D(DTOUT)!$D(DUOUT) G RESUBQ 55 ; 56 ; immediate retransmission of claim 57 I Y="I" D G RESUBQ 58 . S NEW364=$$ADDTBILL^IBCB1(IBIFN) ; Add a new transmission record 59 . I '$P(NEW364,U,3) D Q 60 .. 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 61 .. Q 62 . ; 63 . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J) 64 . S ^TMP("IBONE",$J,+NEW364)="",^TMP("IBONE",$J)=0,^TMP("IBSELX",$J)="" 65 . D ONE^IBCE837 66 . S IBBTCH=$O(^TMP("IBCE-BATCH",$J,0)) ; external batch# 67 . I IBBTCH'="" S IBBTCH=+$G(^TMP("IBCE-BATCH",$J,IBBTCH)) ; internal batch# 68 . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J) 69 . ; 70 . I 'IBBTCH D 71 .. S DIR("A",1)="BILL NOT RESUBMITTED - CHECK ALERTS/MAIL FOR DETAILS" 72 . E D 73 .. N DIE,DR,DA 74 .. D UPDEDI^IBCEM(IB364,"R") ; update EDI files for old transmission 75 .. S DIE="^IBA(364,",DR=".06////"_+IBBTCH,DA=IB364 D ^DIE 76 .. S DIR("A",1)="BILL RESUBMITTED IN BATCH #"_$P($G(^IBA(364.1,+IBBTCH,0)),U,1) 77 . S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR 78 . Q 79 ; 80 ; Later retransmission of claim 81 D UPDEDI^IBCEM(IB364,"R") ; update EDI files for old transmission record 82 S Y=$$ADDTBILL^IBCB1(IBIFN) ; Add a new transmission record 83 S DIR("A",1)="BILL'S TRANSMISSION STATUS RESET TO 'READY TO EXTRACT'" 84 S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " W ! D ^DIR K DIR 85 ; 86 RESUBQ Q 87 ; 88 MGCHK(DSP) ; Returns 1 if mail group IB EDI has at least 1 local member, 89 ; 0 if none found 90 ; DSP = flag that if =1, displays error message 91 N IB 92 S IB=$$GOTLOCAL^XMXAPIG("IB EDI") 93 I 'IB,$G(DSP) D 94 . ; No local members in mail group for EDI messages 95 . 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 " 96 . S DIR(0)="EA" D ^DIR K DIR 97 Q IB 98 ; 1 IBCE ;ALB/TMP - 837 EDI TRANSMISSION UTILITIES/NIGHTLY JOB ;22-JAN-96 2 ;;2.0;INTEGRATED BILLING;**137,283,296**;21-MAR-94 3 EN ; Run all jobs needed for EDI processing nightly 4 ; including transmit bills waiting for extract, batches not sent, 5 N IBLAST,IBZ,IBZ0 6 D NOTSENT^IBCEBUL 7 D EN^IBCE837 8 D EN^IBCEMPRG ; purge status messages from file 361 9 D PURGE^IBCEPTU ; purge transmission detail and claims status data associated with test transmissions after 60 days 10 S IBLAST=$G(^IBA(364.2,"ALAST")),^IBA(364.2,"ALAST")=$$NOW^XLFDT() 11 ; Clean up ACOB xref in 364 12 S IBZ=0 13 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 UPDEDI^IBCEM(IBZ0,"N",1) 14 Q 15 ; 16 EN1 ; Manual entry point for transmitting EDI bills 17 N DIR,X,Y,IBLAST,IBTASK,IBOPTX,DTOUT,DUOUT 18 I '$$MGCHK(1) G EN1Q 19 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" 20 D ^DIR K DIR 21 I $D(DTOUT)!$D(DUOUT) G EN1Q 22 S IBOPTX=Y 23 I Y="A" D G EN1Q 24 . S DIR("A",1)="This option will run a job to transmit ALL bills ready for EDI transmission" 25 . S DIR("A",2)="This option's last scheduled run was "_$$FMTE^XLFDT($G(^IBA(364.2,"ALAST")),2) 26 . S DIR("A",3)=" " 27 . S DIR("A")="Are you absolutely sure this is what you want to do? " 28 . S DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR 29 . Q:'Y 30 . S DIR(0)="YA",DIR("A",1)=" " 31 . S DIR("A",2)="Transmission of ALL bills will be run now" 32 . S DIR("A")="Is this OK? ",DIR("B")="NO" 33 . D ^DIR K DIR 34 . Q:'Y 35 . D EN1^IBCE837B(.IBTASK) 36 . I $G(IBTASK) D 37 .. S DIR("A",1)="Task # for this job is: "_IBTASK 38 . E D 39 .. I $G(IBTASK)'="" S DIR("A",1)="Error encountered in tasking job - check IRM for reported errors" 40 .. S DIR(0)="EA",DIR("A")=" Press RETURN to continue " W !! D ^DIR K DIR 41 I IBOPTX="S" D SUB1^IBCEM03 G EN1Q 42 EN1Q Q 43 ; 44 RESUB(IB364) ; Manually resubmit bill for transmission (ien file 364 = IB364) 45 N DIR,X,Y,IBBTCH,DTOUT,DUOUT 46 I '$$MGCHK(1) G RESUBQ 47 S IBBTCH="" 48 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" 49 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" 50 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" 51 D ^DIR K DIR 52 I $D(DTOUT)!$D(DUOUT) G RESUBQ 53 I Y="I" D G:'IBBTCH RESUBQ 54 . N Y 55 . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J) 56 . S ^TMP("IBONE",$J,IB364)="",^TMP("IBONE",$J)=0,^TMP("IBSELX",$J)="" 57 . D ONE^IBCE837 58 . S IBBTCH=$O(^TMP("IBCE-BATCH",$J,0)) ; external batch# 59 . I IBBTCH'="" S IBBTCH=+$G(^TMP("IBCE-BATCH",$J,IBBTCH)) ; internal batch# 60 . K ^TMP("IBONE",$J),^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J) 61 . I 'IBBTCH D 62 .. S DIR("A",1)="BILL NOT RESUBMITTED - CHECK ALERTS/MAIL FOR DETAILS" 63 . E D 64 .. N DIE,DR,DA 65 .. D UPDEDI^IBCEM(IB364,"R") 66 .. S DIE="^IBA(364,",DR=".06////"_+IBBTCH,DA=IB364 D ^DIE 67 .. S DIR("A",1)="BILL RESUBMITTED IN BATCH #"_$P($G(^IBA(364.1,IBBTCH,0)),U) 68 . S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR 69 I Y="L" D 70 . N Y 71 . D UPDEDI^IBCEM(IB364,"R") 72 . ;Add a new transmission record 73 . S Y=$$ADDTBILL^IBCB1($P($G(^IBA(364,+IB364,0)),U),1) 74 . S DIR("A",1)="BILL'S TRANSMISSION STATUS RESET TO 'READY TO EXTRACT'" 75 . S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE " D ^DIR K DIR 76 ; 77 RESUBQ Q 78 ; 79 MGCHK(DSP) ; Returns 1 if mail group IB EDI has at least 1 local member, 80 ; 0 if none found 81 ; DSP = flag that if =1, displays error message 82 N IB 83 S IB=$$GOTLOCAL^XMXAPIG("IB EDI") 84 I 'IB,$G(DSP) D 85 . ; No local members in mail group for EDI messages 86 . 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 " 87 . S DIR(0)="EA" D ^DIR K DIR 88 Q IB 89 ;
Note:
See TracChangeset
for help on using the changeset viewer.
