source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEM03.m@ 808

Last change on this file since 808 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.6 KB
Line 
1IBCEM03 ;ALB/TMP - 837 EDI RESUBMIT INDIVIDUAL BILL PROCESSING ;17-SEP-96
2 ;;2.0;INTEGRATED BILLING;**137,199,296,348,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6BILL2 ; Resubmit a transmitted bill with a new batch #
7 N DIC,DIR,DIE,DA,DR,IB,IB0,IBDA,IBDA1,IBE,IBSTAT,IBBDA,IBOK,IBNEW,Y,ZTSK,IBTEST
8 K ^TMP("IBEDI_TEST_BATCH",$J)
9 ;
10 S DIR("A")="ARE YOU RESUBMITTING CLAIMS FOR TESTING?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
11 I $D(DTOUT)!$D(DUOUT) Q
12 I +Y S ^TMP("IBEDI_TEST_BATCH",$J)=1
13ASK N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
14 S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
15 ; Only auth or printed transmittable bill valid for non-test
16 ; All previously transmitted valid for test
17 S DIC="^DGCR(399,",DIC(0)="AEMQ",DIC("S")=$S('IBTEST:"I $P($G(^(""TX"")),U,2),$P($G(^(0)),U,13)'="""",""234""[$P($G(^(0)),U,13)",1:"I $O(^IBA(364,""B"",+Y,0))")
18 I IBTEST S DIC("A")="Select BILL/CLAIMS BILL NUMBER (FOR RESUBMIT AS TEST): "
19 D ^DIC K DIC
20 I Y<0 D Q
21 . Q:'IBTEST
22 . I $O(^TMP("IBEDI_TEST_BATCH",$J,0)) D
23 .. M ^TMP("IBRESUBMIT",$J)=^TMP("IBEDI_TEST_BATCH",$J)
24 .. D ONE^IBCE837
25 . ;
26 . K ^TMP("IBEDI_TEST_BATCH",$J),^TMP("IBRESUBMIT",$J)
27 ;
28 S IBIFN=+Y,IBDA=+$$LAST364^IBCEF4(IBIFN),IB0=$G(^IBA(364,IBDA,0)),IBSTAT=$P(IB0,U,3)
29 ;
30 I IB0="" W !,"Bill does not exist in BILL TRANSMISSION file" G ASK
31 I IBTEST,$D(^TMP("IBEDI_TEST_BATCH",$J,IBDA)) W !,"Bill already selected for test transmission" G ASK
32 I $$COBN^IBCEF(IBIFN)=1,IBTEST S IBOK=1 D G:'IBOK ASK
33 . S DIR("A")="BILL IS A PRIMARY BILL, ARE YOU SURE YOU WANT TO SEND IT AS A TEST CLAIM?: "
34 . S DIR("B")="NO",DIR(0)="YA" W ! D ^DIR K DIR
35 . I Y'=1 S IBOK=0
36 ;
37 I 'IBTEST,IBSTAT="X" W !,"Bill is currently awaiting extract - will be submitted with next batch run" G ASK
38 S IBBDA=+$P(IB0,U,2),IB=$P($G(^IBA(364.1,IBBDA,0)),U,9)
39 ;
40 I IB,'IBTEST D G:'IBOK ASK
41 . S IBOK=1,ZTSK=IB D STAT^%ZTLOAD
42 . I ZTSK(0)=0 S DIE="^IBA(364.1,",DA=IBBDA,DR=".09///@" D ^DIE Q ;Task not scheduled - delete task #
43 . I "125"[ZTSK(1) W *7,!,"Cannot resubmit this bill.",!,"This bill's current batch is already ",$S("2"[ZTSK(1):"being resubmitted",1:"scheduled for resubmission")," - Task # is: ",IB,! S IBOK=0
44 ;
45 W !
46 S DIR("A",1)=" Previously In Batch #: "_$$EXPAND^IBTRE(364,.02,$P(IB0,U,2))
47 S DIR("A",2)="Bill Transmission Status: "_$$EXPAND^IBTRE(364,.03,IBSTAT)
48 S DIR("A",3)=" Status Date: "_$$FMTE^XLFDT($P(IB0,U,4),2)
49 S DIR("A",5)=" "
50 S DIR("A",4)=" Current Bill Status: "_$$EXPAND^IBTRE(399,.13,$P($G(^DGCR(399,+IBIFN,0)),U,13))
51 I 'IBTEST,IBSTAT'="P" S DIR("A",11)="WARNING - BILL TRANSMITTED PREVIOUSLY" S:IBSTAT?1"A".E DIR("A",11)=DIR("A",11)_" & CONFIRMED AS RECEIVED BY "_$P("AUSTIN^GENTRAN^INTERMEDIARY^CARRIER",U,$TR(IBSTAT,"A")+1)
52 S DIR("A")="ARE YOU SURE YOU WANT TO RESUBMIT THIS BILL"_$S('IBTEST:"",1:" AS A TEST CLAIM")_"?: "
53 S DIR(0)="YA",DIR("B")="NO"
54 D ^DIR K DIR
55 ;
56 W ! G:'Y ASK
57 ;
58 I IBTEST S ^TMP("IBEDI_TEST_BATCH",$J,IBDA)="" G ASK
59 ;
60 S IBDA1=+$$ADDTBILL^IBCB1(IBIFN) ;Add a new transmit bill record
61 ;
62 S Y=$$TX1^IBCB1(IBDA1,1)
63 ;
64 I 'Y D G ASK
65 . W !,*7,"An error has occurred ... bill NOT re-submitted!!"
66 . S DIK="^IBA(364,",DA=IBDA1 D:DA ^DIK
67 . L -^IBA(364,IBDA)
68 ;
69 S IBNEW=$P($G(^IBA(364,+IBDA1,0)),U,2)
70 ;
71 ;Update the old transmit bill record
72 D UPDEDI^IBCEM(IBDA,"R")
73 ;
74 W !,"Bill # ",$P($G(^DGCR(399,+IB0,0)),U)," was re-submitted in batch # ",$P($G(^IBA(364.1,+IBNEW,0)),U)
75 ;
76 L -^IBA(364,IBDA)
77 G ASK
78 ;
79PRINT1(IBIFN,IBDA,IB364,IBRESUB) ; Print bill, submit manually as resolution
80 ; for a returned message
81 ; IBIFN = ien of bill in file 399
82 ; IBDA = array returned from selection of message
83 ; IB364 = ien of transmit bill entry in file 364
84 ; IBRESUB = flag to indicate if bill is being resubmitted via print
85 ;
86 N IBAC,IBV,IB399,DFN,ZTSK,PRCASV,IBHOLD,IBTXPRT
87 W !
88 I IBIFN="" S IBDA="" G PRINT1Q
89 S IB399=$G(^DGCR(399,IBIFN,0))
90 I "34"'[$P(IB399,U,13) W !,*7,"Bill status must be AUTHORIZED or PRNT/TX to print the bill" S IBDA="" G PRINT1Q
91 ;
92 I $P($G(^DGCR(399,IBIFN,"S")),U,14)=DT W !,*7,"This bill was last printed today. You must wait at least 1 day from the last",!,"print date to print this bill using this function." S IBDA="" D PAUSE^VALM1 G PRINT1Q
93 ;
94 S IBV=1,IBAC=4,DFN=$P(IB399,U,2),IBTXPRT=0
95 M IBHOLD("IBDA")=IBDA
96 D 4^IBCB1,ENS^%ZISS
97 M IBDA=IBHOLD("IBDA")
98 ;
99 I 'IBTXPRT W !,"Bill was not printed" S IBDA="" G PRINT1Q
100 ;
101 D UPDEDI^IBCEM(IB364,"P")
102 ;
103PRINT1Q Q
104 ;
105SUB1 ; Select bills in ready for extract status to transmit individually
106 N IB0,IB399,IBDA,IBIFN,IBSEL,IBU,X,Y,DA,DIC,Z,DIR
107 K ^TMP("IBSELX",$J)
108 ;
109 S IBSEL=""
110 F D Q:'IBSEL
111 . S DIR("S")="I $P(^(0),U,3)=""X"""
112 . S DIR(0)="PAO^364:AEMQ",DIR("A")="SELECT "_$S($D(^TMP("IBSELX",$J)):"NEXT ",1:"")_"BILL TO TRANSMIT: "
113 . S DIR("?")="ONLY BILLS IN 'READY FOR EXTRACT' STATUS CAN BE TRANSMITTED WITH THIS OPTION"
114 . D ^DIR K DIR
115 . I Y'>0 K:Y=U ^TMP("IBSELX",$J) S IBSEL="" Q
116 . S IBSEL=+Y
117 . S IBDA=+Y,IB0=$G(^IBA(364,IBDA,0)),IBIFN=+IB0,IBU=$G(^DGCR(399,IBIFN,"U")),IB399=$G(^(0))
118 . S Z=+$$NEEDMRA^IBEFUNC(IBIFN)
119 . I '$$TXMT^IBCEF4(IBIFN,.IBNOTX),IBNOTX=2 D Q
120 .. W !,$S(Z:"MRA",1:"EDI")_" TRANSMISSION PARAMETER HAS BEEN TURNED OFF",!!,"BILL CANNOT BE SELECTED"
121 . ;
122 . W !
123 . S DIR("A",1)=" YOU HAVE SELECTED BILL #: "_$P(IB399,U)_" ("_$S($$INPAT^IBCEF(IBIFN):"INPATIENT",1:"OUTPATIENT")_"/"_$S($$FT^IBCEF(IBIFN)=3:"UB-04",1:"CMS-1500")_" FORMAT)"
124 . S DIR("A",2)=" PATIENT NAME: "_$E($P($G(^DPT(+$P(IB399,U,2),0)),U)_$J("",28),1,28)_" SSN: "_$P($G(^DPT(+$P(IB399,U,2),0)),U,9)
125 . S DIR("A",3)=" CARE DATE(S): "_$$EXPAND^IBTRE(399,151,$P(IBU,U))_" - "_$$EXPAND^IBTRE(399,152,$P(IBU,U,2))
126 . S DIR("A",4)="'READY TO EXTRACT' STATUS DATE: "_$$EXPAND^IBTRE(364,.04,$P(IB0,U,4))
127 . S DIR("?",1)=" "
128 . S DIR("A",5)=" ",DIR("?")="IF THIS IS THE BILL YOU WANT TO TRANSMIT, RESPOND YES, OTHERWISE, RESPOND NO"
129 . S DIR("A")="ARE YOU SURE THIS IS THE CORRECT BILL TO TRANSMIT?: "
130 . S DIR(0)="YAO",DIR("B")="NO" D ^DIR K DIR W !
131 . I Y'=1 W !,"BILL NOT SELECTED" Q
132 . ;
133 . S ^TMP("IBSELX",$J,IBDA)=""
134 ;
135 I '$O(^TMP("IBSELX",$J,0)) G SUB1Q
136 ;
137 W !,"Bills to be transmitted: "
138 S Z=0 F S Z=$O(^TMP("IBSELX",$J,Z)) Q:'Z W !,?8,$P($G(^DGCR(399,+$G(^IBA(364,Z,0)),0)),U)
139 W !
140 S DIR("A")="OK TO TRANSMIT NOW?: ",DIR(0)="YA0",DIR("B")="NO" D ^DIR K DIR
141 G:Y'=1 SUB1Q
142 W !
143 S ^TMP("IBSELX",$J)=0
144 D ONE^IBCE837
145 W !,"BILL(s) TRANSMITTED ... BATCH #(s): "
146 S Z=0 F S Z=$O(^TMP("IBCE-BATCH",$J,Z)) Q:'Z W Z,$S($O(^(Z)):", ",1:"")
147 I '$O(^TMP("IBCE-BATCH",$J,0)) W !,"NO BILL(S) TRANSMITTED - CHECK ALERTS/MAIL FOR DETAILS"
148 ;
149SUB1Q D PAUSE^VALM1
150 K ^TMP("IBSELX",$J),^TMP("IBCE-BATCH",$J)
151 Q
152 ;
Note: See TracBrowser for help on using the repository browser.