source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P247.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.6 KB
Line 
1IB20P247 ;WOIFO/SS - POST INIT ROUTINE FOR IB*2*247 ;6-OCT-03
2 ;;2.0;INTEGRATED BILLING;**247**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6POST ; adding charge removal reason entries if not there
7 N IBX,IBT,IBY,X,Y,DIC,DO
8 D ADDCRR
9 D ADDNBR
10 Q
11 ;
12ADDCRR ; need to add charge removal reasons
13 N IBX,IBT,IBY,DIC,Y,X
14 F IBX=1:1 S IBY=$P($T(CRR+IBX),";",3,99) Q:IBY="" S IBT=$P(IBY,";") I '$O(^IBE(350.3,"B",IBT,0)) K DO D
15 . S DIC="^IBE(350.3,",DIC(0)="",X=IBT,DIC("DR")=$P(IBY,";",2,3)
16 . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Charge Removal Reasons: "_IBT)
17 Q
18 ;
19ADDNBR ; need to add non billable reasons
20 F IBX=1:1 S IBT=$P($T(NBR+IBX),";",3) Q:IBT="" I '$O(^IBE(356.8,"B",IBT,0)) K DO D
21 . S DIC="^IBE(356.8,",DIC(0)="",X=IBT
22 . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Reason Not Billable: "_IBT)
23 Q
24 ;
25CRR ; charge removal reasons to add in #350.3
26 ;;COMBAT VETERAN;.02///CV;.03///GENERIC
27 ;;
28NBR ; non-billable reasons to add in #356.8 if not there
29 ;;HEAD/NECK CANCER
30 ;;COMBAT VETERAN
31 ;;
32 ;
33 ;-------- report for CV expiration date problem
34RPT ;
35 I '$$PATCH^XPDUTL("DG*5.3*576") W !,"The patch DG*5.3*576 needs to be installed to run the report." Q
36 K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
37 D EN^DGCVEXP
38 N IBDFN,IBDT,IBNNN
39 S IBNNN=0
40 S IBDFN=0 F S IBDFN=$O(^TMP("DGCVEX",$J,IBDFN)) Q:+IBDFN=0 D
41 . S IBDT=0 F S IBDT=$O(^TMP("DGCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D COUNTIN(IBDFN,IBDT,.IBNNN)
42 D PRINTREP(IBNNN)
43 K ^TMP("DGCVEX",$J),^TMP("IBCVEX",$J)
44 Q
45 ;--------
46 ;IBDF - patient's DFN
47 ;IBD - the last date of CV
48COUNTIN(IBDF,IBD,IBNN) ;
49 ;3rd party claims
50 N IBIEN,IBRVDT,IB1,IBTO,IBFR,IBI,IBK
51 S IBIEN=0 F S IBIEN=$O(^DGCR(399,"C",IBDF,IBIEN)) Q:+IBIEN=0 D
52 . S IB1=$G(^DGCR(399,IBIEN,0))
53 . Q:+$P(IB1,"^",5)=0 ;no care type
54 . S IBTO=+$P($G(^DGCR(399,IBIEN,"U")),"^",2),IBFR=+$G(^DGCR(399,IBIEN,"U"))
55 . ;outpatients
56 . I $P(IB1,"^",5)>2 D:IBD=IBFR SETTMP(IBDF,IBD,IBIEN,1,.IBNN) Q
57 . ;inpatients
58 . I (IBD'<IBFR) I IBTO=0!(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,2,.IBNN)
59 ;1st party copays
60 S IBIEN=0 F S IBIEN=$O(^IB("C",IBDF,IBIEN)) Q:+IBIEN=0 D
61 . S IB1=$G(^IB(IBIEN,0)),IBFR=+$P(IB1,"^",14),IBTO=+$P(IB1,"^",15)
62 . I (IBD'<IBFR),(IBD'>IBTO) D SETTMP(IBDF,IBD,IBIEN,3,.IBNN)
63 Q
64 ;--------
65 ; print report
66PRINTREP(IBNN) ;
67 N IBDFN,IBDT,IB1,IBN
68 D HEADER
69 S IBDFN=0 F S IBDFN=$O(^TMP("IBCVEX",$J,IBDFN)) Q:+IBDFN=0 D
70 . S IBDT=0 F S IBDT=$O(^TMP("IBCVEX",$J,IBDFN,IBDT)) Q:+IBDT=0 D
71 .. S IBN=0 F S IBN=$O(^TMP("IBCVEX",$J,IBDFN,IBDT,IBN)) Q:+IBN=0 D OUTP(IBDFN,IBDT,$G(^TMP("IBCVEX",$J,IBDFN,IBDT,IBN)))
72 D FOOTER(IBNN)
73 Q
74 ;--------
75 ;set ^TMP
76SETTMP(IBDFN,IBDT,IBIEN1,IBTYP,IBNUM) ;
77 S IBNUM=IBNUM+1,^TMP("IBCVEX",$J,IBDFN,IBDT,IBNUM)=IBTYP_"^"_IBIEN1
78 Q
79OUTP(IBDFN,IBDT,IBDATA) ;
80 Q:$G(IBDATA)=""
81 N Y S Y=$$PATINFO(IBDFN)
82 W !,$P(Y,"^"),?30,$P(Y,"^",2),?43,$$STRDATE(IBDT),?55,$E($$BILLINFO(IBDATA),1,18)
83 Q
84 ;--------
85 ;billing info
86BILLINFO(IBDATA) ;
87 I +IBDATA=3 Q $P($P($G(^IB(+$P(IBDATA,"^",2),0)),"^",11),"-",2)_" PATIENT"
88 Q $P($G(^DGCR(399,+$P(IBDATA,"^",2),0)),"^")_" INSURANCE"
89 ;--------
90 ;Fileman date to String format
91 ;Y - fileman date
92STRDATE(Y) ;
93 I Y>0 X ^DD("DD") Q Y
94 Q ""
95 ;--------
96 ;patient info
97PATINFO(DFN) ;
98 I +$G(DFN)=0 Q "??"
99 N VADM,VA,VAERR
100 D DEM^VADPT
101 Q $E($G(VADM(1)),1,28)_"^"_$P($G(VADM(2)),"^",2)
102 ;
103 ;--------
104HEADER ;header
105 W !,"...Please wait..."
106 W !,?15,">> CV Billing Verification Report <<"
107 D LINE
108 W !,"Name",?30,"SSN",?43,"Date",?55,"Bill #"
109 D LINE
110 Q
111 ;--------
112FOOTER(IBNNN) ;footer
113 D LINE
114 W !,"Total: "_IBNNN_" bills/copays"
115 Q
116 ;--------
117LINE ;line
118 W !,"-----------------------------",?30,"------------",?43,"-----------",?55,"------------------"
119 Q
120 ;
Note: See TracBrowser for help on using the repository browser.