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

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

initial load of WorldVistAEHR
File size: 5.3 KB
Line 
1IBCRHU1 ;ALB/ARH - RATES: UPLOAD UTILITIES ; 22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,138,245**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6GETXTMP(IBXRF,ARR,ARR1,CS) ; get list of available files
7 ; Output: ARR(file) = upload file description ^ total cnt
8 ; ARR(file,subfile) = I ^ count ^ billable item type ^ charge set
9 ; ARR1(I) = file ^ subfile
10 ;
11 N IBX,IBY,IBL,CNT,IBLN,IBLN1 K ARR,ARR1 S (CNT,ARR,ARR1)=0 I $G(IBXRF)="" S IBXRF="IBCR UPLOAD"
12 S IBL=$L(IBXRF),IBY=$E(IBXRF,IBL),IBY=$A(IBY)-1,IBY=$C(IBY),IBX=$E(IBXRF,1,(IBL-1))_IBY_"~"
13 F S IBX=$O(^XTMP(IBX)) Q:IBX=""!(IBX'[IBXRF) I IBX[IBXRF D
14 . S IBLN=$G(^XTMP(IBX,0)) Q:IBLN=""
15 . S IBY=0 F S IBY=$O(^XTMP(IBX,IBY)) Q:IBY="" D
16 .. S IBLN1=$G(^XTMP(IBX,IBY)) Q:IBLN1="" I +$G(CS),'$P(IBLN1,U,3) Q
17 .. S CNT=CNT+1,(ARR,ARR1)=CNT,ARR1(CNT)=IBX_U_IBY
18 .. S ARR(IBX)=$P(IBLN,U,3,4),ARR(IBX,IBY)=CNT_U_IBLN1
19 Q
20 ;
21DISP(ARR) ; display list of available files by number
22 ;
23 N IBX,IBY,IBLN,IBFCNT S IBFCNT=0
24 S IBX="" F S IBX=$O(ARR(IBX)) Q:IBX="" D
25 . S IBLN=ARR(IBX),IBFCNT=IBFCNT+1
26 . W !!,?5,IBX,?55,"Count = ",$P(IBLN,U,2)
27 . W !,?5,$P(IBLN,U,1)
28 . W !!,?6,"Subfile",?30,"Item",?39,"Count",?49,"Charge Set",!,?6,"-------",?30,"----",?39,"-----",?49,"-------------------------"
29 . S IBY="" F S IBY=$O(ARR(IBX,IBY)) Q:IBY="" D
30 .. S IBLN=ARR(IBX,IBY)
31 .. W !,?2,+IBLN,?6,IBY,?30,$E($$EXPAND^IBCRU1(363.3,.04,$P(IBLN,U,3)),1,5),?39,$P(IBLN,U,2),?49,$E($P($G(^IBE(363.1,+$P(IBLN,U,4),0)),U,1),1,30)
32 W !
33 Q
34 ;
35DISP1(IBXRF,ARR,ARR1,CS) ; get and display uploaded files
36 D GETXTMP($G(IBXRF),.ARR,.ARR1,$G(CS))
37 D DISP(.ARR)
38 Q
39 ;
40CHKDUP(CS,IBLN,ADD) ; check that item would not be a duplicate
41 ; check on same charge but different date removed so each version is complete even if the charge does not change
42 N IBX,IBBI,IBITEM,IBARR S IBX=0
43 S IBBI=$$CSBI^IBCRU3($G(CS)) I 'IBBI S IBX="3^Subfile/Set Error: No Billable Item for the Charge Set" G CHKDUPQ
44 S IBITEM=+$$ITPTR^IBCRU2(+IBBI,$P($G(IBLN),U,1))
45 I 'IBITEM,+IBBI=3,'$G(ADD) S IBX=0 G CHKDUPQ ; new NDC numbers
46 I 'IBITEM S IBX="2^Line/Data Error: Item not found in source file" G CHKDUPQ
47 I $$FINDCI^IBCRU4(CS,IBITEM,$P(IBLN,U,2),$P(IBLN,U,5),"",$J($P(IBLN,U,4),"",2),,,$P(IBLN,U,6)) S IBX="2^Line/Data Error: Duplicate found, the same charge already exists for this item and effective date" G CHKDUPQ
48 I $$FINDCI^IBCRU4(CS,IBITEM,$P(IBLN,U,2),$P(IBLN,U,5)) S IBX="1^Line/Data Warning: Potential duplicate, a charge already exists for this item and effective date" G CHKDUPQ
49 ;I '$P(IBLN,U,3) D ITMCHG^IBCRCC(CS,IBITEM,$P(IBLN,U,2),$P(IBLN,U,5),.IBARR) I +IBARR=1,+$P(IBARR,U,2)=+$P(IBLN,U,4) S IBX="2^Line/Data Error: Charge for item is not modified by the new entry" G CHKDUPQ
50CHKDUPQ Q IBX
51 ;
52CHKLN(BI,IBLN) ; check if data in line item is valid Billable Item
53 ; Input: IBLN= item ^ eff dt ^ inact dt ^ charge ^ cpt modifier
54 ; Output: if data not good: x ^ error description
55 ; w/ x=1 - line/data warning - bad data but field not required
56 ; x=2 - line/data error - bad required data, item can not be loaded into CM
57 ; x=3 - subfile/set error stop all processing
58 ; do not have to check if NDC is in source, since it is added if not there
59 ; check on cpt-modifier pair removed with RC v2.0, charge pairings do not match official pairings
60 N IBX,IBCSBR,IBITEM S IBX=0
61 I +$G(BI)'=3 S IBITEM=+$$ITPTR^IBCRU2(+$G(BI),$P($G(IBLN),U,1)) I 'IBITEM S IBX="2^Line/Data Error: Item not found in source file" G CHKLNQ
62 I +$G(BI)'=3,'$$ITFILE^IBCRU2(+$G(BI),IBITEM,$P(IBLN,U,2)) S IBX="2^Line/Data Error: Not a valid active Item in source file" G CHKLNQ
63 I +$G(BI)=2,+$P(IBLN,U,5),'$P($$MOD^ICPTMOD(+$P(IBLN,U,5),"I",+$P(IBLN,U,2)),U,7) S IBX="2^Line/Data Error: Not a valid active Modifier" G CHKLNQ
64 ;I +$G(BI)=2,+$P(IBLN,U,5),+$$MODP^ICPTMOD(+IBITEM,+$P(IBLN,U,5),"I",$P(IBLN,U,2))<1 S IBX="2^Line/Data Error: Modifier "_$P($$MOD^ICPTMOD(+$P(IBLN,U,5),"I"),U,2)_" can not be used with CPT "_$P(IBLN,U,1) G CHKLNQ
65 I '$$VDATE($P(IBLN,U,2)) S IBX="2^Line/Data Error: Invalid Effective Date" G CHKLNQ
66 I $P(IBLN,U,3),'$$VDATE($P(IBLN,U,3)) S IBX="1^Line/Data Warning: Invalid Inactive Date" G CHKLNQ
67CHKLNQ Q IBX
68 ;
69CHKFL(CS,FILE,IBSUBFL) ; Check the Charge Set and Host file are defined and match ok
70 ; Output: if check is ok: 0
71 ; if data not good: x ^ error description
72 ; w/ x=3 - subfile/set error stop all processing
73 N IBX,IBY,IBCSBI S IBX=0
74 I '$G(CS) S IBX="3^Subfile/Set Error: No Charge Set Defined" G CHKFLQ
75 S IBCSBI=$$CSBI^IBCRU3(CS) I 'IBCSBI S IBX="3^Subfile/Set Error: No Billable Item for the Charge Set" G CHKFLQ
76 ;
77 I $G(FILE)="" S IBX="3^Subfile/Set Error: Invalid Host File Name" G CHKFLQ
78 S IBY=$G(^XTMP(FILE,0)) I IBY="" S IBX="3^Subfile/Set Error: Host File Name Not Defined" G CHKFLQ
79 ;
80 I $G(IBSUBFL)="" S IBX="3^Subfile/Set Error: Invalid Sub-File Name" G CHKFLQ
81 S IBY=$G(^XTMP(FILE,IBSUBFL)) I IBY="" S IBX="3^Subfile/Set Error: File Subset Not Defined" G CHKFLQ
82 I +IBCSBI'=+$P(IBY,U,2) S IBX="3^Subfile/Set Error: Charge Set rate Billable Item ("_$P(IBCSBI,U,2)_") does not match Host file Item ("_$$EXPAND^IBCRU1(363.3,.04,+$P(IBY,U,2))_")" G CHKFLQ
83CHKFLQ Q IBX
84 ;
85VDATE(X) ; check for valid date
86 N Y S Y=0 I +$G(X)?7N,X>2801010,X<3091232 S Y=1
87 Q Y
Note: See TracBrowser for help on using the repository browser.