| 1 | ICD1831L ;ALB/JAP - FY 2008 DRG UPDATE ; 10/17/07 2:33pm
|
|---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
|
|---|
| 3 | ;
|
|---|
| 4 | CONV80(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80
|
|---|
| 5 | ; input ICDINPUT - string containing Dx, MDC, and DRGs
|
|---|
| 6 | ; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
|
|---|
| 7 | N ICDX,ICDRSLT
|
|---|
| 8 | ;if no DRGs passed in, try to get data from set of new Diagnoses
|
|---|
| 9 | ;S ICDX=$P(ICDINPUT,U,3,99) I ICDX="" S ICDRSLT=$$NEW80^ICD1831L(ICDINPUT) Q ICDRSLT
|
|---|
| 10 | S ICDRSLT=$$NEW80^ICD1831L(ICDINPUT) I +$P(ICDRSLT,U,2),+$P(ICDRSLT,U,3) Q ICDRSLT
|
|---|
| 11 | Q $$GETV25^ICD1831L(ICDINPUT)
|
|---|
| 12 | ;
|
|---|
| 13 | CONV801(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80.1
|
|---|
| 14 | ; input ICDINPUT - string containing Dx, MDC, and DRGs
|
|---|
| 15 | ; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
|
|---|
| 16 | Q $$GETV25^ICD1831L(ICDINPUT)
|
|---|
| 17 | ;
|
|---|
| 18 | GETV25(ICDINPUT) ;get MSv25 DRGs from crosswalk tables
|
|---|
| 19 | N ICDRSLT,ICD01,ICDOMDC,ICDMDC,ICDX,ICDXX,ICDD,ICDOD,ICDTAG,ICDROU,ICDTEXT,I,J
|
|---|
| 20 | S ICDRSLT=""
|
|---|
| 21 | I $G(ICDINPUT)="" Q ICDRSLT
|
|---|
| 22 | S ICD01=$P(ICDINPUT,U,1),ICDOMDC=$P(ICDINPUT,U,2),ICDX=$P(ICDINPUT,U,3,99)
|
|---|
| 23 | ;quit if there are no DRGs to convert
|
|---|
| 24 | I ICDX="" S ICDRSLT=ICD01_U_U Q ICDRSLT
|
|---|
| 25 | ;otherwise perform conversion for each DRG
|
|---|
| 26 | F I=1:1 Q:($P(ICDX,U,I)="") D
|
|---|
| 27 | .S ICDOD=+$P(ICDX,U,I) S ICDROU=$S(ICDOD<300:"ICD1831M",1:"ICD1831N")
|
|---|
| 28 | .S ICDTAG="DRG"_ICDOD_"^"_ICDROU
|
|---|
| 29 | .S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
|
|---|
| 30 | .S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
|
|---|
| 31 | .Q:(ICDXX="")
|
|---|
| 32 | .;Q:(ICDMDC'=ICDOMDC)
|
|---|
| 33 | .F J=1:1 Q:($P(ICDXX,U,J)="") S ICDD($P(ICDXX,U,J))=""
|
|---|
| 34 | ;set data into result
|
|---|
| 35 | S ICDRSLT=ICD01_U_ICDOMDC
|
|---|
| 36 | S I=0 F S I=$O(ICDD(I)) Q:'I S ICDRSLT=ICDRSLT_U_I
|
|---|
| 37 | Q ICDRSLT
|
|---|
| 38 | ;
|
|---|
| 39 | NEW80(ICDINPUT) ;get DRG/MDC for new entries in file #80
|
|---|
| 40 | N ICDRSLT,ICD01,ICDTAG,ICDTEXT,ICDMDC,ICDXX,ICDD,I
|
|---|
| 41 | S ICDRSLT=""
|
|---|
| 42 | I $G(ICDINPUT)="" Q ICDRSLT
|
|---|
| 43 | S ICD01=$P(ICDINPUT,U,1)
|
|---|
| 44 | S ICDTAG="DX"_$TR(ICD01,".","")_"^ICD1831R"
|
|---|
| 45 | S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
|
|---|
| 46 | ;quit if no DRG data could be found for Diagnosis
|
|---|
| 47 | I ICDTEXT="" S ICDRSLT=ICD01_U_U Q ICDRSLT
|
|---|
| 48 | ;otherwise return DRGs
|
|---|
| 49 | S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
|
|---|
| 50 | F I=1:1 Q:($P(ICDXX,U,I)="") S ICDD(I)=$P(ICDXX,U,I)
|
|---|
| 51 | S ICDRSLT=ICD01_U_ICDMDC
|
|---|
| 52 | F I=1:1 Q:('$D(ICDD(I))) S ICDRSLT=ICDRSLT_U_ICDD(I)
|
|---|
| 53 | Q ICDRSLT
|
|---|
| 54 | ;
|
|---|
| 55 | NEW801(ICDINPUT,ICDARRAY) ;get DRG/MDC for new entries in file #80.1
|
|---|
| 56 | N ICD01,ICDROU,ICDTAG,ICDTEXT,ICDMDC,ICDXX,I,J
|
|---|
| 57 | K ICDARRAY
|
|---|
| 58 | Q:($G(ICDINPUT)="")
|
|---|
| 59 | S ICD01=$P(ICDINPUT,U,1)
|
|---|
| 60 | S ICDROU="^ICD1831Q"
|
|---|
| 61 | S ICDTAG="PR"_$TR(ICD01,".","")_ICDROU
|
|---|
| 62 | S ICDTEXT=$T(@ICDTAG)
|
|---|
| 63 | Q:(ICDTEXT="")
|
|---|
| 64 | F I=1:1 D Q:(ICDTEXT="END")
|
|---|
| 65 | .S ICDTAG="PR"_$TR(ICD01,".","")_"+"_I_ICDROU
|
|---|
| 66 | .S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
|
|---|
| 67 | .I ICDTEXT'="END" D
|
|---|
| 68 | ..S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
|
|---|
| 69 | ..F J=1:1 Q:($P(ICDXX,U,J)="") S ICDARRAY(ICDMDC,$P(ICDXX,U,J))=""
|
|---|
| 70 | Q
|
|---|
