ICD1831L.m

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 ---ICD1831L   2867     printed  Feb 18, 2025@23:14:50                                                                                                                                                                                                    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