source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICDSUPT.m@ 789

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ICDSUPT ;DLS/DEK - ICD SUPPORT FOR APIS ; 04/28/2003
2 ;;18.0;DRG Grouper;**6**;Oct 20, 2000;Build 1
3 ;
4 ; External References
5 ; DBIA 10103 $$DT^XLFDT
6 ;
7EFF(FILE,CODE,EDT) ; returns effective date and status for code/modifier
8 ; Input:
9 ; FILE = file number REQUIRED
10 ; 80 = ICD DX
11 ; 80.1 = ICD O/P
12 ; CODE = ICD CODE ien REQUIRED
13 ; EDT = date to check (FileMan format) REQUIRED
14 ;
15 ; Output: STATUS^Inactivation Date^Activation Date
16 ; where STATUS = 1 = active
17 ; 0 = inactive
18 ; Activation Date = date code became active
19 ; Inactivation Date = date code became inactive
20 ; -or-
21 ; -1^error message
22 ;
23 ; Variables:
24 ; EFILE = indirect file reference for code
25 ; EFF,EFFDT,EFFDOS,EFFDFLT = effective dates
26 ; EFFN = sub-entry ien
27 ; EFFST = effective status
28 ; STR = output
29 ;
30 I $G(CODE)="" Q "-1^NO CODE SELECTED"
31 I $G(FILE)="" Q "-1^NO FILE SELECTED"
32 I '(FILE=80!(FILE=80.1)) Q "-1^INVALID FILE"
33 I '$G(EDT) Q "-1^NO DATE SELECTED"
34 N EFILE,EFF,EFFN,STR,EFFDT,EFFST,EFFB,EFFDOS
35 S EFILE=$S(FILE=80:"^ICD9(",1:"^ICD0(")_CODE_",66,"
36 S EDT=$S($G(EDT)="":$$DT^XLFDT,1:$$DTBR^ICDAPIU(EDT))+.001 ;date business rules
37 S EFF=$O(@(EFILE_"""B"","_EDT_")"),-1)
38 I 'EFF Q "0^^"
39 S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) ; node 66 (effective date) sub-entry
40 S STR=$G(@(EFILE_EFFN_",0)"))
41 I STR="" Q "0^^"
42 ;set Opposite eff. date based on status
43 S EFFDT=$P(STR,"^"),EFFST=$P(STR,"^",2),EFFB=0,EFF=+EFF
44 F S EFF=$O(@(EFILE_"""B"","_EFF_")"),-1) Q:'EFF!EFFB D
45 . S EFFN=$O(@(EFILE_"""B"","_EFF_",0)")) I 'EFFN S EFFB=1 Q
46 . S EFFDOS=$G(@(EFILE_EFFN_",0)")) I 'EFFDOS S EFFB=1 Q
47 . S EFFB=(EFFST'=$P(EFFDOS,"^",2))
48 S EFFDOS=$P($G(EFFDOS),"^")
49 I EFFST S $P(STR,"^",3,4)=(EFFDOS)_"^"_EFFDT
50 E S $P(STR,"^",3,4)=EFFDT_"^"_(EFFDOS)
51 Q $P(STR,"^",2,4)
52 ;
53NUM(Y) ; convert ICD to $A() of alpha _ numeric portion
54 ; Input: Y - ICD code
55 ; Output: 'plussed' value for ICD OP code,
56 ; numeric for ICD based on $A of 1st character (alpha)
57 ; concatenated with the remainder of the ICD DX code
58 ;
59 ; **This does not convert to ien**
60 ;
61 ; This converts to a numeric that may be used for range sorting
62 ;
63 ; A few ICD DX codes start with "E", "M", or "V" - use ascii
64 ; Remaining ICD DX codes will use 10 as a prefix - insuring DX > OP
65 ; All ICD OP codes match dd.d, dd.dd, or dd.ddd
66 ; where 'd' is a digit; e.g. "V83.89"=8683.89 and "008.8"=10008.8
67 ;
68 Q $S(Y?2N1"."1.3N:+Y,Y?1U2.3N1".".2N:$A($E(Y))_$E(Y,2,6),1:10_$E(Y,2,7))
69 ;
Note: See TracBrowser for help on using the repository browser.