Changeset 636 for FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGX.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRGX.m
r628 r636 1 ICDDRGX ;ALB/EG/MRY/ADL - GROUPER PROCESS ; 11/13/07 3:44pm2 ;;18.0;DRG Grouper;**1,2,5,7,10,14,20,24,27 ,31**;Oct 20, 2000;Build 71 ICDDRGX ;ALB/EG/MRY/ADL - GROUPER PROCESS ; 3/14/05 1:38pm 2 ;;18.0;DRG Grouper;**1,2,5,7,10,14,20,24,27**;Oct 20, 2000;Build 2 3 3 CKHIV ;MDC25 grouping 4 I ICDDATE>3070930.9 G CKHIV^ICDDRGXM ;MS-DRG5 4 ;Q:ICDP25="" 6 5 I ICDPD'["h"&(ICDSD'["h") Q … … 26 25 S:(ICDRG=488)!(ICDRG=489)!(ICDRG=490) ICDRTC=0 27 26 K ICDGH,ICDP25,ICDS25,ICDORNA Q 28 CKMST ;MDC24 grouping ; MS-DRG additions27 CKMST ;MDC24 grouping 29 28 S ICDAJ=0 F ICDS24K=1:1 S ICDAJ=$O(ICDS24(ICDAJ)) Q:ICDAJ="" 30 29 S ICDS24K=ICDS24K-1,ICDS24L=0 F ICDI=1:1:8 S:$D(ICDS24(ICDI))&(ICDI'=ICDP24) ICDS24L=$S($D(ICDS24(ICDI)):1,1:0) 31 30 I ICDOR["u" S ICDS24K=ICDS24K+1 32 31 G:((ICDP24=0)&(ICDS24K<2))!((ICDP24>0)&('ICDS24L)) CKMSTE 33 N CKMST S CKMST=0 34 I ICDDATE>3070930.9 D Q:CKMST ;MS-DRG 35 . S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):955,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):955,1:ICDRG) I ICDRG=955 D CKMSTE S CKMST=1 Q 36 . S:ICDRG'=955 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):956,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):956,1:ICDRG) I ICDRG=956 D CKMSTE S CKMST=1 Q 37 . S:ICDRG'=956 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):959,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):959,1:ICDRG) I ICDRG=959 D CKMSTE S CKMST=1 Q 38 . S ICDRG=$S(ICDP24=0&(ICDS24K>1):965,ICDP24>0&ICDS24L:965,1:ICDRG) 39 . S:(ICDRG>954)&(ICDRG<966) ICDRTC=0 40 E D Q:CKMST ;CMS-DRG 41 . S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):484,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):484,1:ICDRG) I ICDRG=484 D CKMSTE S CKMST=1 Q 42 . S:ICDRG'=484 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):485,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):485,1:ICDRG) I ICDRG=485 D CKMSTE S CKMST=1 Q 43 . S:ICDRG'=485 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):486,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):486,1:ICDRG) I ICDRG=486 D CKMSTE S CKMST=1 Q 44 . S ICDRG=$S(ICDP24=0&(ICDS24K>1):487,ICDP24>0&ICDS24L:487,1:ICDRG) 45 . S:(ICDRG>483)&(ICDRG<488) ICDRTC=0 32 S ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(1))):484,ICDP24>0&($D(ICDO24(1)))&(ICDS24L):484,1:ICDRG) I ICDRG=484 D CKMSTE Q 33 S:ICDRG'=484 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(2))):485,ICDP24>0&($D(ICDO24(2)))&(ICDS24L):485,1:ICDRG) I ICDRG=485 D CKMSTE Q 34 S:ICDRG'=485 ICDRG=$S(ICDP24=0&(ICDS24K>1)&($D(ICDO24(3))):486,ICDP24>0&($D(ICDO24(3)))&(ICDS24L):486,1:ICDRG) I ICDRG=486 D CKMSTE Q 35 S ICDRG=$S(ICDP24=0&(ICDS24K>1):487,ICDP24>0&ICDS24L:487,1:ICDRG) 36 S:(ICDRG>483)&(ICDRG<488) ICDRTC=0 46 37 CKMSTE K ICDAJ,ICDP24,ICDS24,ICDO24,ICDS24K,ICDO24,ICDS24L 47 38 Q 48 39 CKNMDC ;non MDC drg's 49 I ICDDATE>3070930.9 G CKNMDC^ICDDRGXM ;MS-DRG50 40 S:(ICDRG>479)&(ICDRG<484) ICDRG=470 51 41 ; ICD*18*1 - reorder drg 103 higher than all Pre-MDCs 480-83 & 495 … … 65 55 S ICDRG=$S(ICDOR["r":495,1:ICDRG) I ICDRG=495 S ICDRTC=0 Q ;check for lung tx 66 56 S ICDRG=$S(ICDOR["q":103,1:ICDRG) I ICDRG=103 S ICDRTC=0 Q ;check for heart tx 67 S ICDRG=$S(ICDOR["B":481,1:ICD RG) I ICDRG=481 S ICDRTC=0 Q57 S ICDRG=$S(ICDOR["B":481,1:ICDDRG) I ICDRG=481 S ICDRTC=0 Q 68 58 S ICDRG=$S($D(ICDOP(" 30.3"))!$D(ICDOP(" 30.4")):482,1:ICDRG) I ICDRG=482 S ICDRTC=0 Q 69 59 S ICDRG=$S(ICDOR["t"&($P($$ICDDX^ICDCODE(ICDDX(1),ICDDATE),"^",3)["Y"):482,1:ICDRG) I ICDRG=482 S ICDRTC=0 Q … … 72 62 ; 73 63 CHKMDC4 ;MDC 4 drg's 74 I ICDDATE>3070930.9 D ;MS-DRG 75 . I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=168 76 . I ICDDRG=983,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=264 77 . I ICDDRG=983,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=264 ;ICD*18*5 78 E D ;CMS-DRG 79 . I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=76 80 . I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=120 81 . I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=120 ;ICD*18*5 64 I (ICDMDC=4!(ICDMDC=98)),(ICDOR["f") S ICDRG=76 65 I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 86.06")) S ICDRG=120 66 I ICDDRG=468,$G(ICDMDC)=5,$D(ICDOP(" 92.27")),ICDNOR=1 S ICDRG=120 ;ICD*18*5 82 67 Q
Note:
See TracChangeset
for help on using the changeset viewer.