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

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

initial load of WorldVistAEHR
File size: 3.7 KB
Line 
1IBAMTV4 ;ALB/CPM - FIND CHARGES FOR IVM PATIENTS ; 13-JUN-94
2 ;;Version 2.0 ; INTEGRATED BILLING ;**15**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ALL(DFN,IBROOT,IBST,IBEND) ; Find IB Actions and Claims for the IVM Patient
6 ; Input: DFN -- Pointer to the patient in file #2
7 ; IBROOT -- Root in which to place array of charges
8 ; IBST -- Start date used as check for patient charges
9 ; IBEND -- End date used as check for patient charges
10 ;
11 ; Output: Array of charges:
12 ; @IBROOT@(ref #)=1^2^3^4^5^6^7^8^9^10^11, where
13 ; ref # - bill number or field #.01 to #350
14 ; 1 - DFN
15 ; 2 - Classification [1-Inpt,2-Opt,3-Refill,4-Pros]
16 ; 3 - Type [1-Claim,2-Copay,3-Per Diem]
17 ; 4 - Bill From Date
18 ; 5 - Bill To Date
19 ; 6 - Date Bill Created
20 ; 7 - Amt Billed
21 ; 8 - Amt Collected (Claims only)
22 ; 9 - Date Bill Closed (Claims only)
23 ; 10 - Cancelled? [0-No,1-Yes]
24 ; 11 - On Hold? (Patient charges only)
25 ;
26 I $G(IBROOT)=""!'$G(DFN) G ALLQ
27 ;
28 ; - build patient charge array
29 I $G(IBST) S Y="" F S Y=$O(^IB("AFDT",DFN,Y)) Q:'Y I -Y'>IBEND S Y1=0 F S Y1=$O(^IB("AFDT",DFN,Y,Y1)) Q:'Y1 D
30 .S IBDA=0 F S IBDA=$O(^IB("AF",Y1,IBDA)) Q:'IBDA D
31 ..Q:'$D(^IB(IBDA,0)) S IBX=^(0)
32 ..Q:$P(IBX,"^",8)["ADMISSION"
33 ..Q:$P(IBX,"^",9)'=IBDA
34 ..S IBN=$$LAST^IBECEAU(IBDA),IBND=$G(^IB(IBN,0)),IBND1=$G(^(1))
35 ..I $P(IBND,"^",15)<IBST!($P(IBND,"^",14)>IBEND) Q
36 ..;
37 ..; - start building string
38 ..S IBSTR=DFN_"^"_$S($P(IBND,"^",8)["OPT COPAY":2,1:1)
39 ..S IBSTR=IBSTR_"^"_$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["PER DIEM":3,1:2)
40 ..S IBSTR=IBSTR_"^"_$P(IBND,"^",14)_"^"_$P(IBND,"^",15)_"^"_($P(IBND1,"^",4)\1)_"^"_$P(IBND,"^",7)
41 ..S IBSTAT=$G(^IBE(350.21,+$P(IBND,"^",5),0))
42 ..S IBSTR=IBSTR_"^^^"_$P(IBSTAT,"^",5)_"^"_$P(IBSTAT,"^",6)
43 ..I $P(IBSTAT,"^",6) S $P(IBSTR,"^",6)=""
44 ..;
45 ..S @IBROOT@(+IBX)=IBSTR
46 ;
47 ; - build claim array
48 D CLM(DFN,IBROOT)
49 ;
50ALLQ K Y,Y1,IBDA,IBX,IBN,IBND,IBND1,IBSTR,IBSTAT
51 Q
52 ;
53 ;
54INS(IBROOT) ; Find claims for patients with IVM-identified policies.
55 ; Input: IBROOT -- Root in which to place array of charges
56 ; Output: Array of charges as defined above
57 ;
58 N DFN
59 I $G(IBROOT)="" G INSQ
60 S DFN=0 F S DFN=$O(^IBA(354,"AIVM",DFN)) Q:'DFN I '$$CHK^IVMUFNC3(DFN) D CLM(DFN,IBROOT)
61INSQ Q
62 ;
63 ;
64CLM(DFN,IBROOT) ; Build charge array for insurance claims
65 ; Input: DFN -- Pointer to the patient in file #2
66 ; IBROOT -- Root in which to place array of charges
67 ; Output: Array of charges as defined above
68 ;
69 I $G(IBROOT)=""!'$G(DFN) G CLMQ
70 ;
71 N IBN,IBI,IBND,IBX,IBSTR
72 ;
73 S IBN=0 F S IBN=$O(^DGCR(399,"C",DFN,IBN)) Q:'IBN I $$HOWID^IBRFN2(IBN)=3,$P($G(^DGCR(399,IBN,"S")),"^",12) D
74 .F IBI=0,"S","U" S IBND(IBI)=$G(^DGCR(399,IBN,IBI))
75 .;
76 .; - build string
77 .S IBSTR=DFN_"^"_$$CLS(IBN,IBND(0))_"^1"
78 .S IBSTR=IBSTR_"^"_+IBND("U")_"^"_$P(IBND("U"),"^",2)_"^"_$P(IBND("S"),"^",12)
79 .S IBX=$$ORI^PRCAFN(IBN) ; amt billed
80 .S IBSTR=IBSTR_"^"_$S(IBX>0:IBX,1:0)
81 .S IBX=$$TPR^PRCAFN(IBN) ; amt collected
82 .S IBSTR=IBSTR_"^"_$S(IBX>0:IBX,1:0)
83 .S IBX=$$CLO^PRCAFN(IBN) ; date bill closed
84 .S IBSTR=IBSTR_"^"_$S(IBX>0:IBX,1:"")_"^"_$P(IBND("S"),"^",16)
85 .;
86 .S @IBROOT@($$BN^PRCAFN(IBN))=IBSTR
87 ;
88CLMQ Q
89 ;
90CLS(BN,BN0) ; Return a code for the bill classification.
91 ; Input: BN -- Pointer to the bill in file #399
92 ; BN0 -- Zeroth node of bill in file #399
93 N X S X="O"
94 I $G(BN)=""!($G(BN0)="") G CLSQ
95 S X=$$BTYP^IBCOIVM1(BN,BN0)
96CLSQ Q $S(X="I":1,X="O":2,X="R":3,X="P":4,1:2)
Note: See TracBrowser for help on using the repository browser.