source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDREF.m@ 729

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

initial load of FOIAVistA 6/30/08 version

File size: 978 bytes
Line 
1ICDREF ;ALB/EG - GROUPER UTILITY FUNCTIONS ; 5/20/05 8:35pm
2 ;;18.0;DRG Grouper;** 14,17 **;Oct 20, 2000
3RTABLE(ICDRG,ICDDATE) ; Return Reference Table
4 ; Input: ICDRG - DRG entry
5 ; ICDDATE - Date to use for resolving correct entry
6 ;
7 ; Output: Table reference associted with entry from DRG
8 ; file
9 N ICDFY,ICDREF
10 S (ICDFY,ICDREF)=""
11 S ICDFY=$O(^ICD(ICDRG,2,"B",+ICDDATE+.01),-1)
12 S ICDREF=$O(^ICD(ICDRG,2,"B",+ICDFY,ICDREF))
13 S ICDREF=$P($G(^ICD(ICDRG,2,+ICDREF,0)),U,3)
14 Q ICDREF
15VMDC(CODE) ;Get versioned MDC for Diagnosis Code
16 S (MDC,DRGFY)="",DRGFY=$O(^ICD9(CODE,4,"B",+$G(ICDDATE)),-1),MDC=$O(^ICD9(CODE,4,"B",+DRGFY,MDC))
17 Q $P($G(^ICD9(CODE,4,+MDC,0)),U,2)
18 ;
19GETPVMDC ;Get versioned MDC for Op/Pro ICD code from previous years
20 S (DAMDC,DADRGFY)=""
21 F S DRGFY=$O(^ICD0(CODE,2,"B",DRGFY),-1) Q:'DRGFY!(DAMDC>0) D
22 .S DADRGFY=$O(^ICD0(CODE,2,"B",+$G(DRGFY),DADRGFY))
23 .S DAMDC=$O(^ICD0(CODE,2,+DADRGFY,1,"B",ICDMDC,DAMDC))
24 Q
Note: See TracBrowser for help on using the repository browser.