source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831L.m@ 731

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1ICD1831L ;ALB/JAP - FY 2008 DRG UPDATE ; 10/17/07 2:33pm
2 ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
3 ;
4CONV80(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 ;
13CONV801(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 ;
18GETV25(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 ;
39NEW80(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 ;
55NEW801(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
Note: See TracBrowser for help on using the repository browser.