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

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1IBECEA1 ;ALB/RLW-Cancel/Edit/Add... Action Entry Points ; 12-JUN-92
2 ;;2.0;INTEGRATED BILLING;**15,27,45,176,312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PASS ; 'Pass a Charge' Entry Action (added by Jim Moore 4/30/92)
6 N C,IBII,IBNOS,IBND,IBMSG,IBY,IBLINE,IBSTAT,IBAFY,IBATYP,IBHLDR
7 N IBARTYP,IBN,IBSEQNO,IBSERV,IBTOTL,IBTRAN,IBIL,IBNOS2,Y,IBXA
8 ;
9 S VALMBCK="R" D EN^VALM2($G(XQORNOD(0)))
10 I $D(VALMY) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q
11 ;
12 S IBII="" F S IBII=$O(VALMY(IBII)) Q:'IBII D L -^IB(IBNOS2) D MSG
13 .S IBY=1,IBLINE=^TMP("IBACM",$J,IBII,0)
14 .S (IBNOS,IBNOS2)=+$P(^TMP("IBACMIDX",$J,IBII),"^",4)
15 .;
16 .; - perform up-front edits
17 .L +^IB(IBNOS2):5 I '$T S IBMSG="was not passed - record not available, please try again" Q
18 .S IBND=$G(^IB(IBNOS2,0)) I IBND="" S IBMSG="was not passed - record missing the zeroth node" Q
19 .I $P(IBND,"^",12) S IBMSG="was not passed - the charge already has an AR Transaction Number" Q
20 .S IBSTAT=+$P(IBND,"^",5) I $P($G(^IBE(350.21,IBSTAT,0)),"^",4) S IBMSG="was not passed - the status indicates that the charge is billed" Q
21 .I $P(IBND,"^",7)'>0 S IBMSG="was not passed - there is no charge amount" Q
22 .S IBSEQNO=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",5) I 'IBSEQNO S IBMSG="was not passed (Bulletin will be generated)",IBY="-1^IB023" Q
23 .I $P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",11)=6 S IBMSG="was not passed - CHAMPVA charges must be cancelled and rebilled" Q
24 .S IBHLDR=(IBSTAT=21)
25 .; - pass charge to AR and update list
26 .D ^IBR S IBY=$G(Y)
27 .S IBND=$G(^IB(IBNOS2,0))
28 .S (IBSTAT,Y)=$P(IBND,"^",5),C=$P($G(^DD(350,.05,0)),"^",2) D Y^DIQ
29 .S IBLINE=$$SETSTR^VALM1(Y,IBLINE,+$P(VALMDDF("STATUS"),"^",2),+$P(VALMDDF("STATUS"),"^",3))
30 .S IBLINE=$$SETSTR^VALM1($P($P(IBND,"^",11),"-",2),IBLINE,+$P(VALMDDF("BILL#"),"^",2),+$P(VALMDDF("BILL#"),"^",3))
31 .S ^TMP("IBACM",$J,IBII,0)=IBLINE
32 .S IBMSG=$S(+IBY=-1:"was not passed -",IBSTAT=8:"has now been placed ON HOLD",1:"has now been passed")
33 .;
34 .; - if there is no active billing clock, add one
35 .; added check for LTC, don't do this for LTC
36 .S IBXA=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",11)
37 .I $P(IBND,"^",14),'$P($G(^IB(IBNOS2,1)),"^",5),'$D(^IBE(351,"ACT",DFN)),IBXA'=8,IBXA'=9 D
38 ..W !,"This patient has no active billing clock. Adding a new one... "
39 ..S IBCLDT=$P(IBND,"^",14)
40 ..I '$D(IBSERV) D SERV^IBAUTL2
41 ..D CLADD^IBAUTL3 W $S(IBY>0:"done.",1:"error (see msg)")
42 .;
43 .; - if charge was on hold pending review, pass data to IVM
44 .I IBHLDR W !,"Passing billing data to the IVM package... " D IVM^IBAMTV32(IBND) W "done."
45 Q
46 ;
47MSG ; Display results message.
48 W !,"Charge #"_IBII_" "_IBMSG I +IBY=-1 D ^IBAERR1
49 W ! S DIR(0)="E" D ^DIR K DIR W !
50 Q
51 ;
52 ;
53ADD ; 'Add a Charge' Entry Action
54 I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q ;IB*2.0*312
55 G ^IBECEA3
56 ;
57UPD ; 'Edit a Charge' Entry Action
58 S IBAUPD=1
59 ;
60CAN ; 'Cancel a Charge' Entry Action
61 D EN^VALM2(IBNOD(0)) I '$O(VALMY(0)) S VALMBCK="" G CANQ
62 I $G(IBAUPD) I '$$PFSSWARN^IBBSHDWN() S VALMBCK="R" Q ;IB*2.0*312
63 ;
64 S (IBNBR,IBCOMMIT)=0,VALMBCK="R"
65 F S IBNBR=$O(VALMY(IBNBR)) Q:'IBNBR D ^@$S($G(IBAUPD):"IBECEA2",1:"IBECEA4")
66 I IBCOMMIT S IBBG=VALMBG W !,"Rebuilding list of charges..." D ARRAY^IBECEA0 S VALMBG=IBBG
67 K IBBG,IBNBR,IBAUPD,IBCOMMIT
68CANQ Q
69 ;
70PAUSE ; Keep this around for awhile.
71 W ! S DIR(0)="E" D ^DIR K DIR W !
72 Q
Note: See TracBrowser for help on using the repository browser.