| [613] | 1 | ICDSUPT ;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 | ;
|
|---|
| 7 | EFF(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 | ;
|
|---|
| 53 | NUM(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 | ;
|
|---|
