Changeset 636 for FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDDRG0.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/ICDDRG0.m
r628 r636 1 ICDDRG0 ;ALB/GRR/EG/ADL - DRG GROUPER PROCESSING BEGINS ; 11/13/07 4:06pm2 ;;18.0;DRG Grouper;**1,2,7,10,14,17,20,24,27,30 ,31,32**;Oct 20, 2000;Build 91 ICDDRG0 ;ALB/GRR/EG/ADL - DRG GROUPER PROCESSING BEGINS ; 5/16/05 9:05pm 2 ;;18.0;DRG Grouper;**1,2,7,10,14,17,20,24,27,30**;Oct 20, 2000;Build 5 3 3 ;GROUPING PROCESS BEGINS 4 4 ; 5 5 GROUP ; 6 I $D(ICDSEX(1))&($D(ICDSEX(2))) S ICDRTC=4,ICDDRG=$S(ICDDATE>3070930.9:999,1:470) G KILL^ICDDRG 7 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15 D:ICDOPCT<2 I ((ICDDATE'>3070930.9)&("468^476^477"[ICDRG))!((ICDDATE>3070930.9)&("983^986^989"[ICDRG)) G END 6 I $D(ICDSEX(1))&($D(ICDSEX(2))) S ICDRTC=4,ICDDRG=470 G KILL^ICDDRG 7 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15 D:ICDOPCT<2 I "468^476^477"[ICDRG G END 8 . ;I ICDPD["M",ICDOR'["a" S ICDPDRG(344)="",ICDOPCT=0 8 9 . I $D(ICDF) Q 9 10 . I ICDPD["M",ICDOR'["y" S ICDOPCT=0 Q 10 . I ICDDATE>3070930.9 D 11 . . I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(769)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):983,ICDORNI["y":986,ICDORNI["z":989,1:983) Q 12 . . I ICDOPNR S ICDRG=$S(ICDORNI["y":986,1:983),ICDOPNR=0 Q 13 . E D 14 . . I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(377)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):468,ICDORNI["y":476,ICDORNI["z":477,1:468) Q 15 . . I ICDOPNR S ICDRG=$S(ICDORNI["y":476,1:468),ICDOPNR=0 Q 11 .I ICDORNI["O",ICDNOR=ICDONR,ICDNOR>0,'$D(ICDPDRG(377)),ICDORNI'["p" S ICDRG=$S($D(ICDORNI("O")):468,ICDORNI["y":476,ICDORNI["z":477,1:468) Q 12 .I ICDOPNR S ICDRG=$S(ICDORNI["y":476,1:468),ICDOPNR=0 Q 16 13 ; 17 14 ;if number of non-extensive ORs eqs # OR, 477 18 15 ; 19 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI'["y"&(ICDORNI'="")&(ICDORNI["z") D I ((ICDDATE'>3070930.9)&(ICDRG=477))!((ICDDATE>3070930.9)&(ICDRG=989))G END16 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI'["y"&(ICDORNI'="")&(ICDORNI["z") D I ICDRG=477 G END 20 17 . I $D(ICDF) Q 21 . NEW K S K=$$ORNI(ICDORNI) I K=ICDOPCT S ICDRG= $S(ICDDATE>3070930.9:989,1:477)Q18 . NEW K S K=$$ORNI(ICDORNI) I K=ICDOPCT S ICDRG=477 Q 22 19 ; 23 20 ;if number of non-extensive ORs+prostatics eqs # OR, 476 24 21 ; 25 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI["y"&(ICDORNI'="") D I ((ICDDATE'>3070930.9)&(ICDRG=476))!((ICDDATE>3070930.9)&(ICDRG=986))G END26 .N K S K=$$ORNI(ICDORNI) I K=ICDOPCT&(ICDNOR=ICDONR) S ICDRG= $S(ICDDATE>3070930.9:986,1:476)Q27 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDNOR=ICDONR&(ICDOPCT>0) S ICDRG= $S(ICDDATE>3070930.9:983,1:468)G END28 I ICDMDC=5,ICDOR'["O" S ICDRTC=$S(ICDEXP="":5,1:"") S:ICDRTC'="" ICDRG= $S(ICDDATE>3070930.9:999,1:470)D:ICDRTC="" MI G END22 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDORNI["y"&(ICDORNI'="") D I ICDRG=476 G END 23 .N K S K=$$ORNI(ICDORNI) I K=ICDOPCT&(ICDNOR=ICDONR) S ICDRG=476 Q 24 I ICDMDC'=14,ICDMDC'=17,ICDMDC'=18,ICDMDC'=19,ICDMDC'=20,ICDMDC'=23,ICDMDC'=15,ICDNOR=ICDONR&(ICDOPCT>0) S ICDRG=468 G END 25 I ICDMDC=5,ICDOR'["O" S ICDRTC=$S(ICDEXP="":5,1:"") S:ICDRTC'="" ICDRG=470 D:ICDRTC="" MI G END 29 26 ;I ICDMDC=18,ICDOR["O"!(ICDORNI["O") S ICDRG=415 G END ;;disabled by ICD*18*24 and new DRGs 578/579 - see ICDTLB6C 30 I ICDMDC=19,ICDOCNT>0,ICDOR["O" S (ICDRG,HICDRG)= $S(ICDDATE>3070930.9:876,1:424)D CKDRG31 I ICDMDC=23,ICDOR["O"!(ICDORNI["O") S ICDRG= $S(ICDDATE>3070930.9:941,1:461)G END27 I ICDMDC=19,ICDOCNT>0,ICDOR["O" S (ICDRG,HICDRG)=424 D CKDRG 28 I ICDMDC=23,ICDOR["O"!(ICDORNI["O") S ICDRG=461 G END 32 29 I ICDMDC=14 D ^ICDDRG14 I ICDRG]"" G END 33 I ICDMDC=20 S ICDRTC=$S(ICDDMS="":7,1:"") I ICDDMS'=0 D G END 34 . I ICDDATE>3070930.9 S ICDRG=$S(ICDDMS="":999,1:894) Q 35 . S ICDRG=$S(ICDDMS="":470,1:433) 36 I ICDMDC=22 S ICDRTC=$S(ICDTRS="":6,1:"") S:ICDRTC'="" ICDRG=$S(ICDDATE>3070930.9:999,1:470) D:ICDRTC="" CKBURN G END 37 I ICDMDC=15 S ICDRTC=$S(ICDEXP="":5,ICDTRS="":6,1:"") I ICDTRS'=0 D G END 38 . I ICDDATE>3070930.9 S ICDRG=$S(ICDRTC'="":999,1:789) Q 39 . S ICDRG=$S(ICDRTC'="":470,1:385) 40 NEONATE I 'ICDNOR!('$D(ICDODRG)) S ICDRG=$O(ICDPDRG(0)) X "I ICDMDC=15,$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG D NEONATF^ICDDRG0" D D DODRG G GETMOR:ICDRG="",END 30 I ICDMDC=20 S ICDRTC=$S(ICDDMS="":7,1:"") I ICDDMS'=0 S ICDRG=$S(ICDDMS="":470,1:433) G END 31 I ICDMDC=22 S ICDRTC=$S(ICDTRS="":6,1:"") S:ICDRTC'="" ICDRG=470 D:ICDRTC="" CKBURN G END 32 I ICDMDC=15 S ICDRTC=$S(ICDEXP="":5,ICDTRS="":6,1:"") I ICDTRS'=0 S ICDRG=$S(ICDRTC'="":470,1:385) G END 33 NEONATE I 'ICDNOR!('$D(ICDODRG)) S ICDRG=$O(ICDPDRG(0)) X "I ICDMDC=15,$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))" D D DODRG G GETMOR:ICDRG="",END 41 34 . N X,X1,X2,% 42 35 . S X1=$S($G(DGADM):$G(DGADM),1:DT),X2=$G(DOB) I X1,X2 D ^%DTC I X<29 D NBCOMP Q 43 . I ICDDATE'>3070930.9 I ICDRG<385!(ICDRG>391) Q 44 . I ICDDATE>3070930.9 I ICDRG<789!(ICDRG>795) Q 36 . I ICDRG<385!(ICDRG>391) Q 45 37 .; I "^11917^11918^11921^"[("^"_ICDDX(1)_"^") S ICDRG=395 Q 46 . I ICDDATE'>3070930.9 I $O(ICDRG(391)) S ICDRG=$O(ICDRG(391)) Q 47 . I ICDDATE>3070930.9 I $O(ICDRG(795)) S ICDRG=$O(ICDRG(795)) Q 48 . I 'ICDRG S ICDRG=$S(ICDDATE>3070930.9:999,1:470),ICDRTC=8 49 I AGE="",ICDMDC=3 S ICDRTC=3 S ICDRG=$S(ICDDATE>3070930.9:999,1:470) G END 38 . I $O(ICDRG(391)) S ICDRG=$O(ICDRG(391)) Q 39 . I 'ICDRG S ICDRG=470,ICDRTC=8 40 I AGE="",ICDMDC=3 S ICDRTC=3,ICDRG=470 G END 50 41 D ^ICDDRG1:ICDMDC=1,^ICDDRG2:ICDMDC=2,^ICDDRG3:ICDMDC=3,^ICDDRG5:ICDMDC=5,^ICDDRG6:ICDMDC=6,^ICDDRG7:ICDMDC=7,^ICDDRG8:ICDMDC=8,^ICDDRG9:ICDMDC=9,^ICDDRG10:ICDMDC=10,^ICDDRG11:ICDMDC=11,^ICDDRG12:ICDMDC=12,^ICDDRG13:ICDMDC=13 51 42 D ^ICDDRG17:ICDMDC=17 … … 53 44 D DODRG 54 45 G:ICDRG'>0 LOOK8:ICDMDC=8,AGAIN G END 55 ENTER I 'ICDNOR,ICDORNR'=0,ICDMDC'=20,ICDMDC'=15 S ICDRG= $S(ICDDATE>3070930.9:983,1:468)G END56 GETMOR S (ICDRG,HICDRG)=$O(ICDPDRG(0)) S:ICDRG'>0 (ICDRG,HICDRG)= $S(ICDDATE>3070930.9:998,1:469)46 ENTER I 'ICDNOR,ICDORNR'=0,ICDMDC'=20,ICDMDC'=15 S ICDRG=468 G END 47 GETMOR S (ICDRG,HICDRG)=$O(ICDPDRG(0)) S:ICDRG'>0 (ICDRG,HICDRG)=469 ;I ICDMDC=15,'$D(ICDODRG),$D(ICDSDRG),$O(ICDSDRG(0))<ICDRG S (ICDRG,HICDRG)=$O(ICDSDRG(0)) 57 48 CKDRG D DODRG 58 49 I ICDRG="" K ICDPDRG(HICDRG) G GETMOR … … 61 52 N DRGFY,ICDREF S (DRGFY,ICDREF)="" 62 53 I ICDRG S DRGFY=$O(^ICD(ICDRG,2,"B",$P(+$G(ICDDATE),".")_.01),-1) 63 I 'DRGFY S DRGFY=30 71001 ;default to current fiscal year54 I 'DRGFY S DRGFY=3061001 ;default to current fiscal year 64 55 S ICDREF=$O(^ICD(+ICDRG,2,"B",+DRGFY,ICDREF)) 65 56 I ICDREF'="" D … … 75 66 D:ICDP24'=""!($D(ICDS24)) CKMST^ICDDRGX S ICDDRG=ICDRG 76 67 ;ICD*18*24 check for higher numbered DRG (such as new DRG 561) before checking for 489 in CKHIV^ICDDRGX 77 I ICDDATE<3071001 I ICDRG=489!(ICDRG=490)!(ICDRG=543&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=543 S ICDRG=561 78 I ICDDATE'<3071001 I ICDRG=976!(ICDRG=977)!(ICDRG=24&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=24 S ICDRG=99 68 I ICDRG=489!(ICDRG=490)!(ICDRG=543&($G(ICDOR)="")) S ICDRG=$P($G(ICDPDRG),U,2) I ICDRG=543 S ICDRG=561 79 69 D:$G(ICDP25)=1!(($G(ICDP25)>1)&($D(ICDS25(1)))) CKHIV^ICDDRGX S ICDDRG=ICDRG 80 70 ; this will effectively make DRG 103 into a pre-MDC (ICD*18*1) 81 I $D(ICDOP(" 33.6"))!$D(ICDOP(" 37.5"))!(ICDDATE>3030930.9&($D(ICDOP(" 37.51"))!$D(ICDOP(" 37.66")))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG 82 I (ICDDATE>3050930.9)&($D(ICDOP(" 37.64")))&($D(ICDOP(" 37.65"))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG 83 I (ICDDATE>3060930.9)&($D(ICDOP(" 37.63")))&($D(ICDOP(" 37.64"))) S ICDRG=$S(ICDDATE>3070930.9:2,1:103),ICDNMDC(1)="" D DODRG 84 I $D(ICDOP(" 39.65")) S ICDRG=$S(ICDDATE>3070930.9:3,1:541),ICDNMDC(1)="" 85 I (ICDDATE>3070930.9)&($D(ICDOP(" 46.97"))) S ICDRG=5,ICDNMDC(1)="" 71 I $D(ICDOP(" 33.6"))!$D(ICDOP(" 37.5"))!(ICDDATE>3030930.9&($D(ICDOP(" 37.51"))!$D(ICDOP(" 37.66")))) S ICDRG=103,ICDNMDC(1)="" 72 I (ICDDATE>3050930.9)&($D(ICDOP(" 37.64")))&($D(ICDOP(" 37.65"))) S ICDRG=103,ICDNMDC(1)="" 73 I (ICDDATE>3060930.9)&($D(ICDOP(" 37.63")))&($D(ICDOP(" 37.64"))) S ICDRG=103,ICDNMDC(1)="" 74 I $D(ICDOP(" 39.65")) S ICDRG=541,ICDNMDC(1)="" 86 75 ; this will create DRGs 512/513 as pre-MDC 87 I $D(ICDOP(" 52.80"))!$D(ICDOP(" 52.82")) S ICDRG=$S(ICDDATE>3070930.9:10,1:513),ICDNMDC(1)="" 88 I (ICDDATE>3070930.9) D 89 . I ICDRG=10 I $D(ICDOP(" 55.69")) S ICDRG=8 90 E I ICDRG=513 I $D(ICDOP(" 55.69")) S ICDRG=512 76 I $D(ICDOP(" 52.80"))!$D(ICDOP(" 52.82")) S ICDRG=513,ICDNMDC(1)="" 77 I ICDRG=513 I $D(ICDOP(" 55.69")) S ICDRG=512 91 78 ; this will create DRG 481 as pre-MDC - loops thru 41.00 thru .09 92 N X S X=0 F S X=$O(ICDOP(X)) Q:X="" I X["41.0" S ICDRG= $S(ICDDATE>3070930.9:9,1:481),ICDNMDC(1)=""79 N X S X=0 F S X=$O(ICDOP(X)) Q:X="" I X["41.0" S ICDRG=481,ICDNMDC(1)="" 93 80 I $D(ICDNMDC(1)) I ICDNMDC(1)="" D CKNMDC^ICDDRGX S ICDDRG=ICDRG K ICDNMDC 94 I ICDDATE>3070930.9 D 95 . I ICDRG=983 D CHKMDC4^ICDDRGX 96 . D DODRG S ICDDRG=ICDRG ;check for MCC/CC 97 E I ICDRG=468 D CHKMDC4^ICDDRGX D DODRG S ICDDRG=ICDRG 81 I ICDRG=468 D CHKMDC4^ICDDRGX D DODRG S ICDDRG=ICDRG 98 82 S:ICDRTC="" ICDRTC=0 99 S ICDTMP=$$DRG^ICDGTDRG(ICDDRG,ICDDATE) I '$P(ICDTMP,U,14) S ICDDRG= $S(ICDDATE>3070930.9:999,1:470)83 S ICDTMP=$$DRG^ICDGTDRG(ICDDRG,ICDDATE) I '$P(ICDTMP,U,14) S ICDDRG=470 100 84 G KILL^ICDDRG 101 85 MI ; 102 86 ; if PTCA and not a bypass 103 I ICDOR["1"!($D(ICDOP(" 37.90"))) I ICDOR'["b"&(ICDOR'["6") D Q 104 . I ICDDATE>3070930.9 D CMS516^ICDTBL2 Q 105 . E D DRG516^ICDTLB6B 87 I ICDOR["1"!($D(ICDOP(" 37.90"))) I ICDOR'["b"&(ICDOR'["6") I ICDDATE>3050930.9 D DRG516^ICDTLB6B Q 106 88 I ICDPD["A" D EN1^ICDDRG5 I ICDCC3 S ICDRG=$O(ICDODRG(0)) D DODRG Q 107 89 I ICDPD["AI"!(ICDSD["AI") D Q 108 . I ICDDATE>3070930.9 D 109 . . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):285,ICDPD["V"!(ICDSD["V"):280,1:282) 110 . E D 111 . . I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=526 Q 112 . . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):123,ICDPD["V"!(ICDSD["V"):121,1:122) 113 I $D(ICDOP(" 37.26"))&($D(ICDOP(" 39.61"))) S ICDRG=$S(ICDDATE>3070930.9:230,1:108) Q 90 . I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=526 Q 91 . S ICDRG=$S($S($D(ICDEXP):ICDEXP,1:0):123,ICDPD["V"!(ICDSD["V"):121,1:122) 92 I $D(ICDOP(" 37.26"))&($D(ICDOP(" 39.61"))) S ICDRG=108 Q 114 93 ;I $D(ICDOP(" 37.26")) S ICDRG=112 Q 115 I ICDDATE<3071001 I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=527 Q 116 I ICDDATE<3071001 I $D(ICDOP(" 36.06")) I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=517 Q 117 I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=$S(ICDDATE>3070930.9:251,1:518) Q 118 I ICDOR["H" D Q 119 . I ICDDATE>3070930.9 S ICDRG=$S(ICDPD["X"!(ICDSD["X"):286,1:287) Q 120 . E S ICDRG=$S(ICDPD["X"!(ICDSD["X"):124,1:125) Q 121 I ICDDATE>3070930.9 K ICDPDRG(286),ICDPDRG(287) 122 E K ICDPDRG(124) 94 I $D(ICDOP(" 36.07")) I $D(ICDOP(" 37.26"))!($D(ICDOP(" 37.27"))) S ICDRG=527 Q 95 I $D(ICDOP(" 36.06")) I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=517 Q 96 I $D(ICDOP(" 37.26"))!$D(ICDOP(" 37.27")) S ICDRG=518 Q 97 I ICDOR["H" S ICDRG=$S(ICDPD["X"!(ICDSD["X"):124,1:125) Q 98 K ICDPDRG(124) 123 99 I ICDOR["p" S ICDRG=$O(ICDODRG(0)) D DODRG Q 124 100 I ICDOR["F" S ICDRG=$O(ICDODRG(0)) D DODRG Q 125 E D Q 126 . I ICDDATE>3070930.9 K ICDPDRG(280),ICDPDRG(281),ICDPDRG(282) S ICDRG=$O(ICDPDRG(0)) D DODRG Q 127 . E K ICDPDRG(121) S ICDRG=$O(ICDPDRG(0)) D DODRG Q 101 E K ICDPDRG(121) S ICDRG=$O(ICDPDRG(0)) D DODRG Q 128 102 ; 129 103 CKBURN ; MDC22 - Burns (extensive, full thickness, or non-extensive) 130 104 D 131 . I ICDPD["*"!(ICDSD["*") D Q 132 . . I ICDDATE>3070930.9 S ICDRG=$S(ICDOR["k":927,1:933) Q 133 . . E S ICDRG=$S(ICDOR["k":504,1:505) Q 105 . I ICDPD["*"!(ICDSD["*") S ICDRG=$S(ICDOR["k":504,1:505) Q 134 106 . I ICDPD["b"!(ICDSD["b") D FTBURN Q 135 . I ICDDATE>3070930.9 S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):935,1:935) 136 . E S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):510,1:511) 107 . S ICDRG=$S(ICDCC!(ICDPD["T")!(ICDSD["T"):510,1:511) 137 108 Q 138 109 ; … … 151 122 N ICDSDXCK 152 123 S ICDSDXCK=$O(ICDSDRG(0)) 153 I ICDDATE>3070930.9 D 154 . I ICDSDXCK<ICDRG,ICDSDXCK>788,ICDSDXCK<796 D 155 .. S ICDRG=$S($D(ICDPDRG(795)):795,$D(ICDPDRG(791)):791,1:$O(ICDSDRG(0))) 156 E D 157 . I ICDSDXCK<ICDRG,ICDSDXCK>384,ICDSDXCK<392 D 158 .. S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0))) 124 I ICDSDXCK<ICDRG,ICDSDXCK>384,ICDSDXCK<392 D 125 . S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0))) 159 126 Q 160 127 ; 161 128 FTBURN ; full thickness burn check 162 129 I ICDSD["j"!(ICDOR["k") D 163 . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG= $S(ICDDATE>3070930.9:928,1:506)164 . E S ICDRG= $S(ICDDATE>3070930.9:929,1:507)130 . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=506 131 . E S ICDRG=507 165 132 E D 166 . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG= $S(ICDDATE>3070930.9:934,1:508)167 . E S ICDRG= $S(ICDDATE>3070930.9:934,1:509)133 . I ICDCC!(ICDPD["T")!(ICDSD["T") S ICDRG=508 134 . E S ICDRG=509 168 135 Q 169 ;170 NEONATF ;NEONATE - Continuation of xecute line171 I ICDDATE>3070930.9 S ICDRG=$S($D(ICDPDRG(795)):795,$D(ICDPDRG(791)):791,1:$O(ICDSDRG(0))) Q172 S ICDRG=$S($D(ICDPDRG(391)):391,$D(ICDPDRG(387)):387,1:$O(ICDSDRG(0)))173 Q
Note:
See TracChangeset
for help on using the changeset viewer.