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

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IBCVC ;ALB/WCJ - VALUE CODE FUNCTIONALITY ;25-JUN-07
2 ;;2.0;INTEGRATED BILLING;**371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 G AWAY
5AWAY Q
6 ;
7ALLOWVC(IBIFN,Y) ; see if the value code is obsolete.
8 ; returns 0 = Not Allowed/Obsolete
9 ; returns 1 = Allowed
10 ;
11 N OBSDT,SCF
12 S OBSDT=$$GET1^DIQ(399.1,Y,.26,"I")
13 D CLEAN^DILF
14 Q:'+OBSDT 1 ; If there is no obsolete date, were cool
15 ;
16 S SCF=$$GET1^DIQ(399,IBIFN,151,"I") ; get the statement covers from date to compare with
17 D CLEAN^DILF
18 I 'SCF Q 0 ; if there is none, not sure where to go with this. It's required so I say fail.
19 ;
20 I SCF>OBSDT Q 0
21 ;
22 Q 1
23 ;
24HELP ;
25 Q:'$G(DA)
26 Q:'$G(DA(1))
27 Q:'$D(^DGCR(399,DA(1),"CV",DA,0))
28 N VCPTR
29 S VCPTR=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U)
30 Q:VCPTR=""
31 Q:'$D(^DGCR(399.1,VCPTR,1))
32 N LOOP
33 S LOOP=0 F S LOOP=$O(^DGCR(399.1,VCPTR,1,LOOP)) Q:'+LOOP D
34 . W !,$G(^(LOOP,0))
35 Q
36 ;
37FORMCHK(X,DA) ; Check to make sure that the VALUE is in the correct format base on the VALUE CODE.
38 ; This tag is the input transform for the VALUE field (Sub-File 399.047, field .02).
39 ;
40 ; X = data being verified
41 ; DA = subfile entry
42 ; DA(1) = IEN to 399
43 ;
44 ; returns
45 ; 0 = invalid format
46 ; 1 = valid format
47 ;
48 Q:'$G(DA) 0
49 Q:'$G(DA(1)) 0
50 Q:'$D(^DGCR(399,DA(1),"CV",DA,0)) 0
51 ;
52 N VCPTR
53 S VCPTR=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U)
54 Q:VCPTR="" 0
55 ;
56 Q $$CHK(VCPTR,X)
57 ;
58CHK(VCPTR,X) ; This tag is called from the input transform above and also from the IB edit check routines (IBCBB*)
59 ; This function is passed in:
60 ; VCPTR - pointer into file #399.1
61 ; X - the VALUE being checked
62 ; Returns:
63 ; 0 or false - Invalid format or can't figure it out.
64 ; 1 or true - valid format (or in the case of 24, defined at the state level)
65 ;
66 N CODE,OK
67 S CODE=$$GET1^DIQ(399.1,VCPTR_",",.02,"I")
68 D CLEAN^DILF
69 Q:CODE="" 0
70 ;
71 N AMTFLG
72 ;
73 ; Check to see if it goes out as a monetary amount.
74 S AMTFLG=$$GET1^DIQ(399.1,VCPTR_",",.19,"I")
75 D CLEAN^DILF
76 I AMTFLG Q X?1(1.7N,.7N1"."1.2N)
77 ;
78 ; Medicaid Rate Code (This is defined at the state level)
79 Q:CODE=24 1
80 ;
81 ; Accident Hour
82 I CODE=45 Q ".00.01.02.03.04.05.06.07.08.09.10.11.12.13.14.15.16.17.18.19.20.21.22.23.99."[("."_X_".")
83 ;
84 ; Whole Numbers
85 I ".37.38.39.46.50.51.52.53.56.57.58.59.67.68."[("."_CODE_".") Q X?1.7N
86 ;
87 ; Zip
88 I CODE="A0" Q X?5N
89 ;
90 I ".48.49."[("."_CODE_".") S OK=1 D Q OK
91 . I $P(X,".")'?.2N S OK=0 Q
92 . I $P(X,".",2,999)'?.1N S OK=0 Q
93 . I $E(X,$L(X))="." S OK=0 Q
94 ;
95 ; Alpha Numeric, no punctuation
96 I ".60.61."[("."_CODE_".") Q X?1.7AN
97 Q 1
98 ;
99REMOVE(DA) ; Remove the VALUE field since it's in the wrong format.
100 ; This is called from a NEW STYLE X-REF "AC" in file 399.047 field .01
101 N IENS,FDA
102 Q:'$G(DA)!'$G(DA(1))
103 S IENS=DA_","_DA(1)_","
104 S FDA(399.047,IENS,.02)="@"
105 D FILE^DIE(,"FDA")
106 D CLEAN^DILF
107 Q
108 ;
109COND(DA,OLDVC,NEWVC) ; Check if the VALUE is in a valid format for the new VALUE CODE.
110 ; This is called from a NEW STYLE X-REF "AC" in file 399.047 field .01
111 ; This function will return:
112 ; 1 - Means that this VALUE should be deleted (It's in the wrong format)
113 ; 0 - Means that this VALUE should NOT be deleted
114 Q:'$G(OLDVC) 0
115 Q:'$G(DA)!'$G(DA(1)) 0
116 N OLDVALUE
117 S OLDVALUE=$P($G(^DGCR(399,DA(1),"CV",DA,0)),U,2)
118 Q:OLDVALUE="" 0
119 Q '$$CHK(NEWVC,OLDVALUE)
Note: See TracBrowser for help on using the repository browser.