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

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1IBCA3 ;ALB/AAS - MCCR SINGLE LINE DISPLAY OF BILL ;12/22/89
2 ;;2.0;INTEGRATED BILLING;**52,80,106,51**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;MAP TO DGCRA3
6 ;
7EN1 ;entry for one bill, must pass IBIFN
8 K DGSELNO D HDR,ONE
9 G END
10 ;
11EN2 ;Find all bills for a patient must pass dfn
12 S IBQUIT=0 D UTIL S:'$D(IBPAUS) IBPAUS=5
13 I 'IBCNT W !,"No Bills On File for this Patient!" G EN2Q
14 K DGSELNO D HDR S (IBDT,IBIFN)="",IBCNT=0
15 F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT) F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) S IBCNT=IBCNT+1 D ONE,PAUSE:'(IBCNT#IBPAUS)
16EN2Q D END Q
17 ;
18EN3 ;Find all bills for a patient on one episode date. must pass dfn, episode date in x
19 S IBQUIT=0 D UTIL,UTIL1
20 I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN3Q
21 K DGSELNO S IBIFN="",IBCNT=0,IBDT=-(X+.99),IBDT1=X
22 F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT)!(IBDT>-IBDT1) F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) S IBCNT=IBCNT+1 D HDR:IBCNT=1,ONE,PAUSE:'(IBCNT#5)
23 F K=0:0 S K=$O(^UTILITY($J,"IB",K)) Q:'K!(IBQUIT) S IBCNT=IBCNT+1 D HDR1:IBCNT=1,ONE1,PAUSE:'(IBCNT#5)
24 I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN3Q
25EN3Q D END Q
26EN4 ;Find all bills beginning a CEOC and allow selection by number, pass dfn
27 K ^UTILITY($J) S (DGSELNO,IBQUIT)=0 D UTIL
28 I 'IBCNT W !,"No Other Bills for this Episode Date on File!" G EN4Q
29 S (IBDT,IBIFN)="",IBCNT=0,IBPAUS=5
30 F K=0:0 S IBDT=$O(^UTILITY($J,IBDT)) Q:'IBDT!(IBQUIT) D 41
31 D:'IBQUIT PAUSE:'$D(IBIDS(.17))
32EN4Q K DIC,DGSELNO D END Q
33 ;
3441 F J=0:0 S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:'IBIFN!(IBQUIT) D SCRN ;S IBCNT=IBCNT+1 D ONE,PAUSE:'(IBCNT#IBPAUS)
35 Q
36SCRN S A=$P(^DGCR(399,IBIFN,0),"^",17)
37 I A=IBIFN S DGSELNO=DGSELNO+1,^UTILITY($J,"IBSEL",DGSELNO)=IBIFN,^UTILITY($J,"IBSEL",$P(^DGCR(399,A,0),"^"))=IBIFN D HDR:DGSELNO=1,ONE,PAUSE:'(DGSELNO#IBPAUS)
38 Q
39 ;
40ONE D GVAR^IBCBB W !
41 S DGTAB=2 I $D(DGSELNO) W DGSELNO S DGTAB=4 ;write selection numbers here
42 W ?DGTAB,IBBNO,?13,$S($P(IBND0,U,27)=1:"I",$P(IBND0,U,27)=2:"P",1:"")
43 W ?15,$S(IBCL=2:"HE ",IBCL=4:"HE ",1:""),$$BCHGTYPE^IBCU(IBIFN),?29
44 W $S(IBWHO="p":"Pat",IBWHO="i":"Ins",1:"Oth"),$S($P(IBND0,U,21)="S":" s",$P(IBND0,U,21)="T":" t",1:""),?36
45 F I=IBEVDT,IBFDT,IBTDT W $E(I,4,5)_"/"_$E(I,6,7)_"/"_$E(I,2,3)," "
46 W ?66,$S(IBST=1:"Enterd",IBST=2:"ReqMRA",IBST=3:"Auth. ",IBST=4:"Pr/Txd",1:"Cancel")," "
47 W ?74,$S(IBTF=1:"Ad-Ds",IBTF=2:"Int FC",IBTF=3:"Int CC",IBTF=4:"Int LC",IBTF=5:"Late",IBTF=6:"Adjust",IBTF=7:"Replac",IBTF=0:"ZERO",1:"")
48 Q
49 ;
50ONE1 ; Display IB Actions. Input: K, X
51 N C,D,I,Y S D=$G(^IB(K,0))
52 W !,?2,$P($P(D,"^",11),"-",2),?13,$S($P($G(^IBE(350.1,+$P(D,"^",3),0)),"^")["OPT":"Outpt.",1:"Inpat."),?28,"Patnt",?36
53 F I=X,$P(D,"^",14),$P(D,"^",15) W $$DAT1^IBOUTL(I)," "
54 S C=$P(^DD(350,.05,0),"^",2),Y=$P(D,"^",5) D Y^DIQ W ?66,$E(Y,1,4),?72,$$ACTNM($P(D,"^",3),1)
55 Q
56 ;
57HDR S DGTAB=$S($D(DGSELNO):4,1:2) W !,?DGTAB,"Bill #",?13,"Classf ($typ)",?29,"Payer",?36,"Event DT From DT To Date",?66,"Status",?74,"Timefm"
58 W !,?DGTAB,"------",?13,"-------------",?29,"-----",?36,"-------- -------- --------",?66,"------",?74,"------"
59 Q
60 ;
61HDR1 ; Write header to dislay IB Actions.
62 W !,?2,"Bill #",?13,"Classf",?28,"Payer",?36,"Event DT From DT To Date",?66,"Stat",?72,"Act Typ"
63 W !,?2,"------",?13,"-------",?28,"-----",?36,"-------- -------- --------",?66,"----",?72,"------"
64 Q
65 ;
66PAUSE I '$D(DGSELNO),$E(IOST,1,2)["C-" R !!,"Enter ""^"" to quit display, return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,'$T:1,1:0) Q
67ASK I '$D(DGSELNO),DGSELNO<1 Q
68 W !!,"CHOOSE 1" W:DGSELNO>1 "-",DGSELNO W " or ENTER BILL NUMBER: " R IBX:DTIME I IBX="^"!('$T) S IBQUIT=1 Q
69 Q:IBX=""
70 I $D(^UTILITY($J,"IBSEL",IBX)) S Y=^(IBX) I $D(^DGCR(399,Y,0)) S Y(0)=^(0) W " ",$P(Y(0),"^") S IBIDS(.17)=$P(Y(0),"^",17),IBQUIT=1 Q
71 ;
72HELPSEL W !!,"Enter 1-",DGSELNO," to select that entry or enter the Bill Number" G ASK
73 Q
74 ;
75UTIL S IBIFN1="",IBCNT=0 K ^UTILITY($J)
76 F J=0:0 S IBIFN1=$O(^DGCR(399,"C",DFN,IBIFN1)) Q:IBIFN1="" S IBCNT=IBCNT+1,IBEVDT=$P(^DGCR(399,IBIFN1,0),"^",3),^UTILITY($J,-IBEVDT,IBIFN1)=""
77 Q
78 ;
79UTIL1 ; Get IB charges for a patient for a single event date. Input: DFN, X
80 N Y,Y1
81 S Y=0 F S Y=$O(^IB("AFDT",DFN,-X,Y)) Q:'Y S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 I $D(^IB(Y1,0)),$P(^(0),"^",8)'["ADMISSION" S IBCNT=IBCNT+1,^UTILITY($J,"IB",Y1)=""
82 Q
83 ;
84END D END^IBCBB1
85 K A,DGTAB,IBIFN1,IBPAUS,IBQUIT,IBX1,IBDT,IBDT1,IBCNT,^UTILITY($J)
86 Q
87 ;
88ACTNM(X,P) ; returns external form of action type (350.1), short or long
89 N X1,Y S P=$S(+$G(P):2,1:8),X=+$G(X)
90 S X1=$P($G(^IBE(350.1,+X,0)),"^",9) ;new action type
91 S Y=$P($G(^IBE(350.1,+X1,0)),"^",P) I Y="" S Y=$P($G(^IBE(350.1,+X,0)),"^",P) I Y="" S Y=$P($G(^IBE(350.1,+X,0)),"^")
92 Q Y
Note: See TracBrowser for help on using the repository browser.