ICD1831L ;ALB/JAP - FY 2008 DRG UPDATE ; 10/17/07 2:33pm
;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
;
CONV80(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80
; input ICDINPUT - string containing Dx, MDC, and DRGs
; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
N ICDX,ICDRSLT
;if no DRGs passed in, try to get data from set of new Diagnoses
;S ICDX=$P(ICDINPUT,U,3,99) I ICDX="" S ICDRSLT=$$NEW80^ICD1831L(ICDINPUT) Q ICDRSLT
S ICDRSLT=$$NEW80^ICD1831L(ICDINPUT) I +$P(ICDRSLT,U,2),+$P(ICDRSLT,U,3) Q ICDRSLT
Q $$GETV25^ICD1831L(ICDINPUT)
;
CONV801(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80.1
; input ICDINPUT - string containing Dx, MDC, and DRGs
; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
Q $$GETV25^ICD1831L(ICDINPUT)
;
GETV25(ICDINPUT) ;get MSv25 DRGs from crosswalk tables
N ICDRSLT,ICD01,ICDOMDC,ICDMDC,ICDX,ICDXX,ICDD,ICDOD,ICDTAG,ICDROU,ICDTEXT,I,J
S ICDRSLT=""
I $G(ICDINPUT)="" Q ICDRSLT
S ICD01=$P(ICDINPUT,U,1),ICDOMDC=$P(ICDINPUT,U,2),ICDX=$P(ICDINPUT,U,3,99)
;quit if there are no DRGs to convert
I ICDX="" S ICDRSLT=ICD01_U_U Q ICDRSLT
;otherwise perform conversion for each DRG
F I=1:1 Q:($P(ICDX,U,I)="") D
.S ICDOD=+$P(ICDX,U,I) S ICDROU=$S(ICDOD<300:"ICD1831M",1:"ICD1831N")
.S ICDTAG="DRG"_ICDOD_"^"_ICDROU
.S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
.S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
.Q:(ICDXX="")
.;Q:(ICDMDC'=ICDOMDC)
.F J=1:1 Q:($P(ICDXX,U,J)="") S ICDD($P(ICDXX,U,J))=""
;set data into result
S ICDRSLT=ICD01_U_ICDOMDC
S I=0 F S I=$O(ICDD(I)) Q:'I S ICDRSLT=ICDRSLT_U_I
Q ICDRSLT
;
NEW80(ICDINPUT) ;get DRG/MDC for new entries in file #80
N ICDRSLT,ICD01,ICDTAG,ICDTEXT,ICDMDC,ICDXX,ICDD,I
S ICDRSLT=""
I $G(ICDINPUT)="" Q ICDRSLT
S ICD01=$P(ICDINPUT,U,1)
S ICDTAG="DX"_$TR(ICD01,".","")_"^ICD1831R"
S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
;quit if no DRG data could be found for Diagnosis
I ICDTEXT="" S ICDRSLT=ICD01_U_U Q ICDRSLT
;otherwise return DRGs
S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
F I=1:1 Q:($P(ICDXX,U,I)="") S ICDD(I)=$P(ICDXX,U,I)
S ICDRSLT=ICD01_U_ICDMDC
F I=1:1 Q:('$D(ICDD(I))) S ICDRSLT=ICDRSLT_U_ICDD(I)
Q ICDRSLT
;
NEW801(ICDINPUT,ICDARRAY) ;get DRG/MDC for new entries in file #80.1
N ICD01,ICDROU,ICDTAG,ICDTEXT,ICDMDC,ICDXX,I,J
K ICDARRAY
Q:($G(ICDINPUT)="")
S ICD01=$P(ICDINPUT,U,1)
S ICDROU="^ICD1831Q"
S ICDTAG="PR"_$TR(ICD01,".","")_ICDROU
S ICDTEXT=$T(@ICDTAG)
Q:(ICDTEXT="")
F I=1:1 D Q:(ICDTEXT="END")
.S ICDTAG="PR"_$TR(ICD01,".","")_"+"_I_ICDROU
.S ICDTEXT=$T(@ICDTAG),ICDTEXT=$P(ICDTEXT,";;",2)
.I ICDTEXT'="END" D
..S ICDXX=$P(ICDTEXT,";",1),ICDMDC=$P(ICDTEXT,";",2)
..F J=1:1 Q:($P(ICDXX,U,J)="") S ICDARRAY(ICDMDC,$P(ICDXX,U,J))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD1831L 2867 printed Nov 22, 2024@16:58:38 Page 2
ICD1831L ;ALB/JAP - FY 2008 DRG UPDATE ; 10/17/07 2:33pm
+1 ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
+2 ;
CONV80(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80
+1 ; input ICDINPUT - string containing Dx, MDC, and DRGs
+2 ; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
+3 NEW ICDX,ICDRSLT
+4 ;if no DRGs passed in, try to get data from set of new Diagnoses
+5 ;S ICDX=$P(ICDINPUT,U,3,99) I ICDX="" S ICDRSLT=$$NEW80^ICD1831L(ICDINPUT) Q ICDRSLT
+6 SET ICDRSLT=$$NEW80^ICD1831L(ICDINPUT)
IF +$PIECE(ICDRSLT,U,2)
IF +$PIECE(ICDRSLT,U,3)
QUIT ICDRSLT
+7 QUIT $$GETV25^ICD1831L(ICDINPUT)
+8 ;
CONV801(ICDINPUT) ;convert CMSv24 DRG to MSv25 DRG for file #80.1
+1 ; input ICDINPUT - string containing Dx, MDC, and DRGs
+2 ; <.01_field>_^_<mdc_ien>_^_<drg1_ien>_^_<drg2_ien>_^...
+3 QUIT $$GETV25^ICD1831L(ICDINPUT)
+4 ;
GETV25(ICDINPUT) ;get MSv25 DRGs from crosswalk tables
+1 NEW ICDRSLT,ICD01,ICDOMDC,ICDMDC,ICDX,ICDXX,ICDD,ICDOD,ICDTAG,ICDROU,ICDTEXT,I,J
+2 SET ICDRSLT=""
+3 IF $GET(ICDINPUT)=""
QUIT ICDRSLT
+4 SET ICD01=$PIECE(ICDINPUT,U,1)
SET ICDOMDC=$PIECE(ICDINPUT,U,2)
SET ICDX=$PIECE(ICDINPUT,U,3,99)
+5 ;quit if there are no DRGs to convert
+6 IF ICDX=""
SET ICDRSLT=ICD01_U_U
QUIT ICDRSLT
+7 ;otherwise perform conversion for each DRG
+8 FOR I=1:1
if ($PIECE(ICDX,U,I)="")
QUIT
Begin DoDot:1
+9 SET ICDOD=+$PIECE(ICDX,U,I)
SET ICDROU=$SELECT(ICDOD<300:"ICD1831M",1:"ICD1831N")
+10 SET ICDTAG="DRG"_ICDOD_"^"_ICDROU
+11 SET ICDTEXT=$TEXT(@ICDTAG)
SET ICDTEXT=$PIECE(ICDTEXT,";;",2)
+12 SET ICDXX=$PIECE(ICDTEXT,";",1)
SET ICDMDC=$PIECE(ICDTEXT,";",2)
+13 if (ICDXX="")
QUIT
+14 ;Q:(ICDMDC'=ICDOMDC)
+15 FOR J=1:1
if ($PIECE(ICDXX,U,J)="")
QUIT
SET ICDD($PIECE(ICDXX,U,J))=""
End DoDot:1
+16 ;set data into result
+17 SET ICDRSLT=ICD01_U_ICDOMDC
+18 SET I=0
FOR
SET I=$ORDER(ICDD(I))
if 'I
QUIT
SET ICDRSLT=ICDRSLT_U_I
+19 QUIT ICDRSLT
+20 ;
NEW80(ICDINPUT) ;get DRG/MDC for new entries in file #80
+1 NEW ICDRSLT,ICD01,ICDTAG,ICDTEXT,ICDMDC,ICDXX,ICDD,I
+2 SET ICDRSLT=""
+3 IF $GET(ICDINPUT)=""
QUIT ICDRSLT
+4 SET ICD01=$PIECE(ICDINPUT,U,1)
+5 SET ICDTAG="DX"_$TRANSLATE(ICD01,".","")_"^ICD1831R"
+6 SET ICDTEXT=$TEXT(@ICDTAG)
SET ICDTEXT=$PIECE(ICDTEXT,";;",2)
+7 ;quit if no DRG data could be found for Diagnosis
+8 IF ICDTEXT=""
SET ICDRSLT=ICD01_U_U
QUIT ICDRSLT
+9 ;otherwise return DRGs
+10 SET ICDXX=$PIECE(ICDTEXT,";",1)
SET ICDMDC=$PIECE(ICDTEXT,";",2)
+11 FOR I=1:1
if ($PIECE(ICDXX,U,I)="")
QUIT
SET ICDD(I)=$PIECE(ICDXX,U,I)
+12 SET ICDRSLT=ICD01_U_ICDMDC
+13 FOR I=1:1
if ('$DATA(ICDD(I)))
QUIT
SET ICDRSLT=ICDRSLT_U_ICDD(I)
+14 QUIT ICDRSLT
+15 ;
NEW801(ICDINPUT,ICDARRAY) ;get DRG/MDC for new entries in file #80.1
+1 NEW ICD01,ICDROU,ICDTAG,ICDTEXT,ICDMDC,ICDXX,I,J
+2 KILL ICDARRAY
+3 if ($GET(ICDINPUT)="")
QUIT
+4 SET ICD01=$PIECE(ICDINPUT,U,1)
+5 SET ICDROU="^ICD1831Q"
+6 SET ICDTAG="PR"_$TRANSLATE(ICD01,".","")_ICDROU
+7 SET ICDTEXT=$TEXT(@ICDTAG)
+8 if (ICDTEXT="")
QUIT
+9 FOR I=1:1
Begin DoDot:1
+10 SET ICDTAG="PR"_$TRANSLATE(ICD01,".","")_"+"_I_ICDROU
+11 SET ICDTEXT=$TEXT(@ICDTAG)
SET ICDTEXT=$PIECE(ICDTEXT,";;",2)
+12 IF ICDTEXT'="END"
Begin DoDot:2
+13 SET ICDXX=$PIECE(ICDTEXT,";",1)
SET ICDMDC=$PIECE(ICDTEXT,";",2)
+14 FOR J=1:1
if ($PIECE(ICDXX,U,J)="")
QUIT
SET ICDARRAY(ICDMDC,$PIECE(ICDXX,U,J))=""
End DoDot:2
End DoDot:1
if (ICDTEXT="END")
QUIT
+15 QUIT
