source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBAMTI1.m@ 686

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1IBAMTI1 ;ALB/CPM - SPECIAL INPATIENT BILLING CASES (CON'T.) ; 11-AUG-93
2 ;;2.0;INTEGRATED BILLING;**52,132,156,199,234,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5DISP ; Manually disposition a case record.
6 W !!,"This option is used to disposition case records for special inpatient"
7 W !,"episodes of care which are not to be billed. (AO/IR/SWA/SC/MST/HNC/CV/SHAD)"
8 W !,"After identifying the case, please enter the reason (up to 80 characters)"
9 W !,"for non-billing."
10 ;
11 ; - main processing loop
12 S IBQ=0 F W ! D SEL Q:IBQ
13 K IBQ
14 Q
15 ;
16SEL ; Select an inpatient billing case and enter the reason for non-billing.
17 S DIC="^IBE(351.2,",DIC(0)="QEAMZ",DIC("A")="Select PATIENT: "
18 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
19 D ^DIC S IBC=+Y I Y<0 S IBQ=1 G SELQ
20 I $P(Y(0),"^",5)=1 W !!,"You must wait until this patient has been discharged to disposition the case." G SELQ
21 I $P(Y(0),"^",4) S IBBILLED=1 W !!,"Please note that it appears as if this case has been billed."
22 I $P(Y(0),"^",8) W !!,"Please note that this case has already been dispositioned."
23 ;
24 ; - display case record
25 W ! D DSPL(IBC)
26 ;
27 ; - allow user update of record
28 S IBHC=$P(Y(0),"^",7),IBHR=$G(^IBE(351.2,IBC,1))
29 S DIE="^IBE(351.2,",DA=IBC,DR=$S($G(IBBILLED):".07;",1:"")_1 D ^DIE
30 ;
31 S IBNC=$P(^IBE(351.2,IBC,0),"^",7),IBNR=$G(^IBE(351.2,IBC,1))
32 I IBHC=IBNC,IBHR=IBNR W !!,"No changes made to the case record!" G SELQ
33 I IBNR]"" W !!,"This case record will be dispositioned."
34 S DR="2.03////"_DUZ_";2.04///NOW"
35 I IBNR]"" S DR=".07////1;.08////1;"_DR
36 S DIE="^IBE(351.2,",DA=IBC D ^DIE
37SELQ K DA,DIC,DIE,DR,IBC,IBHC,IBHR,IBNC,IBNR,IBBILLED
38 Q
39 ;
40CEA(IBPM,IBEVT) ; Automatically disposition the case from Cancel/Edit/Add.
41 ; Input: IBPM -- Pointer to the adm movement in file #405
42 ; IBEVT -- Pointer to the billing event record in file #350
43 I '$G(IBEVT) G CEAQ
44 N DA,DIE,DR,IBC
45 S IBC=$O(^IBE(351.2,"AC",+$G(IBPM),0)) I IBC D UPD(0)
46CEAQ Q
47 ;
48CHK(IBC,IBEVT) ; Review the case after adding a charge from Cancel/Edit/Add.
49 ; Input: IBC -- Pointer to the case in file #351.2
50 ; IBEVT -- Pointer to the billing event record in file #350
51 I '$G(IBC)!'$G(IBEVT) G CHKQ
52 N DA,DIE,DR,IBCD,IBCD1
53 S IBCD=$G(^IBE(351.2,IBC,0)),IBCD1=$G(^(1))
54 I $P(IBCD,"^",7)!'$P(IBCD,"^",8)!(IBCD1]"") D UPD(1)
55CHKQ Q
56 ;
57UPD(IND) ; Disposition the case record.
58 ; Input: IND -- 0 = dispositioning | 1 = reviewing
59 ; variables -- IBC => ptr to case record
60 ; IBEVT => ptr to event record in #350
61 W !,"Dispositioning the special inpatient billing case record"
62 W:$G(IND) " (as billable)" W "..."
63 K ^IBE(351.2,IBC,1)
64 S DR=".04////"_IBEVT_";.07////0;.08////1;2.03////"_DUZ_";2.04///NOW"
65 S DIE="^IBE(351.2,",DA=IBC D ^DIE W " done."
66 Q
67 ;
68DSPL(IBC) ; Display a case record.
69 ; Input: IBC -- Pointer to the case record in file #351.2
70 I '$G(IBC) G DSPLQ
71 N DFN,IBCD,IBC1,IBC2,IBATYP,IBPT,IBDIS,IBCL,IBEVT,IBN,IBND,Y
72 S IBCD=$G(^IBE(351.2,IBC,0)),IBC1=$G(^(1)),IBC2=$G(^(2))
73 S DFN=+IBCD,IBPT=$$PT^IBEFUNC(DFN),IBCL=$P(IBCD,"^",3)
74 W !,$$DASH(),!?1,"Pt. Name: ",$E($P(IBPT,"^"),1,17)," (",$P(IBPT,"^",3),")"
75 W ?38,"Care related to ",$$PATTYAB^IBACV(IBCL),": ",$S($P(IBCD,"^",7):"YES",$P(IBCD,"^",7)=0:"NO",1:"UNANSWERED")
76 W !?5,"Type: ",$$UCCL^IBAMTI(IBCL),?39,"Case Dispositioned: ",$S($P(IBCD,"^",8):"YES",1:"NO")
77 W !?1,"Adm Date: ",$$DAT1^IBOUTL(+$G(^DGPM(+$P(IBCD,"^",2),0)),1),?41,"Date Last Edited: ",$$DAT1^IBOUTL(+$P(IBC2,"^",4),1)
78 S IBDIS=+$G(^DGPM(+$P($G(^DGPM(+$P(IBCD,"^",2),0)),"^",17),0))
79 W !,"Disc Date: ",$S(IBDIS:$$DAT1^IBOUTL(IBDIS,1),1:"Still Admitted"),?43,"Last Edited By: ",$E($P($G(^VA(200,+$P(IBC2,"^",3),0)),"^"),1,20),!,$$DASH()
80 ;
81 S IBEVT=+$P(IBCD,"^",4)
82 I $O(^IB("AF",IBEVT,IBEVT)) W !?1,"Charges Billed:" D
83 .S IBN=0 F S IBN=$O(^IB("AF",IBEVT,IBN)) Q:'IBN I IBN'=IBEVT D
84 ..S IBND=$G(^IB(IBN,0))
85 ..S IBATYP=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")
86 ..S:$E(IBATYP,1,2)="DG" IBATYP=$E(IBATYP,4,99)
87 ..W !?5,IBATYP,?35,$$DAT1^IBOUTL($P(IBND,"^",14)),?46,$$DAT1^IBOUTL($P(IBND,"^",15))
88 ..W ?57,"$",$P(IBND,"^",7),?64,$P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2)
89 .W !,$$DASH()
90 ;
91 I IBC1]"" W !?1,"Reason for Non-Billing:",!,IBC1,!,$$DASH(),!
92DSPLQ Q
93 ;
94DASH() ; Return a dashed line.
95 Q $TR($J("",80)," ","-")
Note: See TracBrowser for help on using the repository browser.