ICDEXD2.m

ICDEXD2 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;12/19/2014

 ;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21

 ;               

 ; Global Variables

 ;    ^ICDS(              N/A

 ;               

 ; External References

 ;    $$DT^XLFDT          ICR  10103

 ;    $$FMADD^XLFDT       ICR  10103

 ;    $$FMTE^XLFDT        ICR  10103

 ;    ^%DT                ICR  10003

 ;    ^DIR                ICR  10026

 ;               

 Q

MD(FILE,IEN,CDT,ARY,FLAG) ; MDC DRGs

 ;

 ; Input

 ;

 ;    FILE   File Number/Identifier

 ;    IEN    Internal entry in file

 ;    CDT    Code Set Versioning Date

 ;   .ARY    Array name passed by reference

 ;    FLAG   Flag   I=Internal (default)

 ;                  E=External

 ;

 ; Output

 ;

 ;   ICD Procedures file 80.1 (multiple MDC)

 ;   

 ;      ARY(<fiscal year>,<MDC>)=DRG^;FY;STA

 ;      ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA

 ;   

 ;      If Flag contains "E"

 ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 ;      ARY(<fiscal year>,"E","FY")=External FY

 ;   

 ;   ICD Diagnosis file 80 (single MDC)

 ;   

 ;      ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA

 ;   

 ;      If Flag contains "E"

 ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 ;      ARY(<fiscal year>,"E","FY")=External FY

 ;   

 ;   NOTE:  If no Fiscal Year found for the input 

 ;   date then the first (earliest) Fiscal Year is 

 ;   used.

 ;

 N DRG,FY,FYIEN,MDC,MDCIEN,MY,MYIEN,ROOT,STA,STR S FLAG=$G(FLAG) S:'$L(FLAG) FLAG="I"

 S FILE=$G(FILE) S:FILE=9!(FILE["ICD9") FILE=80  S:FILE=0!(FILE["ICD0") FILE=80.1

 Q:"^80^80.1^"'[("^"_FILE_"^") "-1;Invalid file selected"

 S IEN=+($G(IEN)),CDT=$P($G(CDT),".",1)

 S ROOT=$$ROOT^ICDEX(FILE) S:CDT'?7N CDT=$$DT^XLFDT

 Q:'$L(ROOT) "-1;Invalid file selected"

 K ARY I FILE=80.1 D

 . S STA=1,FY=$O(^ICD0(IEN,2,"B",(CDT+.001)),-1)

 . S:FY'?7N STA=0,FY=$O(^ICD0(IEN,2,"B","")) Q:FY'?7N

 . S FYIEN=$O(^ICD0(IEN,2,"B",+$G(FY),0)) Q:+FYIEN'>0

 . S MDC=0 F  S MDC=$O(^ICD0(IEN,2,FYIEN,1,"B",MDC)) Q:'$L(MDC)  D

 . . S MDCIEN=0 F  S MDCIEN=$O(^ICD0(IEN,2,FYIEN,1,"B",MDC,MDCIEN)) Q:+MDCIEN'>0  D

 . . . S STR="",DRG=""

 . . . F  S DRG=$O(^ICD0(IEN,2,FYIEN,1,MDCIEN,1,"B",DRG)) Q:'$L(DRG)  S STR=STR_DRG_"^"

 . . S ARY(FY,MDC)=STR_";"_FY_";"_STA

 . . I FLAG["E" D

 . . . N ED,EMDC,DRGI,IDRG,DRGOUT

 . . . S ED=$$FMTE^XLFDT(FY,"5DZ"),EMDC=$P($G(^ICM(+MDC,0)),"^",1)

 . . . S ARY(FY,"E","FY")=ED,ARY(FY,"E",MDC)=EMDC

 . . . F DRGI=1:1 Q:'$L($P($G(STR),"^",DRGI))  D

 . . . . N IDRG,DRGOUT S IDRG=$P($G(STR),"^",DRGI) Q:+IDRG'>0

 . . . . K DRGOUT D DRGD^ICDGTDRG(IDRG,"DRGOUT",,$G(CDT))

 . . . . S:$L($G(DRGOUT(1)))&(+DRGI>0) ARY(FY,"E",MDC,IDRG)=$G(DRGOUT(1))

 I FILE=80 D

 . S STA=1,FY=$O(^ICD9(IEN,3,"B",(CDT+.001)),-1)

 . S:FY'?7N STA=0,FY=$O(^ICD9(IEN,3,"B","")) Q:FY'?7N

 . S MY=$O(^ICD9(IEN,4,"B",(FY+.001)))

 . S:MY'?7N MY=$O(^ICD9(IEN,4,"B",""))

 . S MYIEN=$O(^ICD9(IEN,4,"B",+$G(MY),0))

 . S MDC=$P($G(^ICD9(IEN,4,+MYIEN,0)),"^",2)

 . S FYIEN=$O(^ICD9(IEN,3,"B",+$G(FY),0)) Q:+FYIEN'>0

 . S STR="",DRG=""

 . F  S DRG=$O(^ICD9(IEN,3,FYIEN,1,"B",DRG)) Q:'$L(DRG)  S STR=STR_DRG_"^"

 . I +MDC'>0 S MDC=$$DRGMDC^ICDEXD(+STR)

 . S ARY(FY,MDC)=STR_";"_FY_";"_STA

 . I FLAG["E" D

 . . N ED,EMDC,DRGI,IDRG,DRGOUT

 . . S ED=$$FMTE^XLFDT(FY,"5DZ"),EMDC=$P($G(^ICM(+MDC,0)),"^",1)

 . . S ARY(FY,"E","FY")=ED,ARY(FY,"E",MDC)=EMDC

 . . F DRGI=1:1 Q:'$L($P($G(STR),"^",DRGI))  D

 . . . N IDRG,DRGOUT S IDRG=$P($G(STR),"^",DRGI) Q:+IDRG'>0

 . . . K DRGOUT D DRGD^ICDGTDRG(IDRG,"DRGOUT",,$G(CDT))

 . . . S:$L($G(DRGOUT(1)))&(+DRGI>0) ARY(FY,"E",MDC,IDRG)=$G(DRGOUT(1))

 Q

VMDCDX(IEN,CDT) ; Get versioned MDC for Diagnosis Code

 ;

 ; Input

 ;

 ;    IEN    Internal Entry Number file 80

 ;    CDT    Code Set Versioning Date

 ;

 ; Output

 ;

 ;   $$VMDCDX  Versioned MDC

 ;

 N ICDI,ICDD,ICDS,ICDM,ICDY S ICDI=+($G(IEN)) Q:'$D(^ICD9(ICDI,4,"B")) ""

 S ICDS=$P($G(^ICD9(+ICDI,1)),"^",1),ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS)

 S (ICDM,ICDY)="",ICDY=$O(^ICD9(+ICDI,4,"B",(ICDD+.0001)),-1)

 S ICDM=$O(^ICD9(ICDI,4,"B",+ICDY,ICDM))

 Q $P($G(^ICD9(ICDI,4,+ICDM,0)),U,2)

VMDCOP(IEN,MDC,CDT) ; Get versioned MDC for Op/Pro ICD code from previous years

 ;

 ; Input

 ;

 ;    IEN    Internal Entry Number file 80.1

 ;    MDC    Major Diagnostic Category

 ;    CDT    Code Set Versioning Date

 ;

 ; Output

 ;

 ;   $$VMDCOP  4 piece "^" delimited string

 ;

 ;             1   Fiscal Year  Fileman format

 ;             2   MDC          Pointer to file 80.3

 ;             3   Fiscal Year  pointer to sub-file 80.171

 ;                              (formerly known as DADRGFY)

 ;             4   MDC          pointer to sub-file 80.1711

 ;                                (formerly known as DAMDC)

 ;

 N ICDI,ICDC,ICDD,ICDO,ICDY,ICDM,ICDS S ICDI=+($G(IEN)) Q:'$D(^ICD0(ICDI,2,"B")) ""

 S ICDC=$G(MDC) Q:'$L(MDC) ""  S ICDS=$P($G(^ICD0(+ICDI,1)),"^",1)

 S ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS) S (ICDM,ICDY)=""

 S ICDD=ICDD+.0001 F  S ICDD=$O(^ICD0(ICDI,2,"B",ICDD),-1) Q:'ICDD!(ICDM>0)  D

 . S ICDY=$O(^ICD0(ICDI,2,"B",+$G(ICDD),ICDY)),ICDO=ICDD

 . S ICDM=$O(^ICD0(ICDI,2,+ICDY,1,"B",ICDC,ICDM))

 Q:'$L($G(ICDO)) ""

 Q (ICDO_"^"_ICDC_"^"_ICDY_"^"_ICDM)

 ;

MDCG(IEN,CDT,ARY) ; Set up ICDMDC() array

 ;

 ; Input

 ;

 ;    IEN    ICD Diagnosis (IEN)

 ;    CDT    Code Set Versioning Date

 ;   .ARY    Array name passed by reference

 ;

 ; Output

 ;

 ;    ARY    Array listing MDCs for all DRGs

 ;

 ;      ARY=MDC

 ;      ARY(MDC)=""

 ;

 N I,ICDC,ICDO,ICDTMP,ICDS,ICDD,DRGS S IEN=$G(IEN) Q:+IEN'>0  S ICDS=$P($G(^ICD9(+IEN,1)),"^",1)

 S ICDD=$$DTBR^ICDEX($G(CDT),0,ICDS) Q:'$L(IEN)  S ICDO=$G(ARY) K ARY S:$L(ICDO) ARY=ICDO

 S ICDTMP=$$GETDRG^ICDEX(80,IEN,ICDD) Q:'$P(ICDTMP,";",3)  S DRGS=$P(ICDTMP,";")

 F I=1:1 Q:'$L($P(DRGS,"^",I))  Q:'$P(DRGS,"^",I)  D

 . N DRG,MDC S DRG=$P(DRGS,"^",I) Q:DRG=""  S MDC=$P($$DRG^ICDGTDRG(DRG,ICDD),"^",5) Q:MDC=""  S ARY(MDC)=""

 Q

MDCT(IEN,CDT,ARY,FMT) ; For Multiple MDC DX Codes

 ;

 ; Input:

 ;

 ;    IEN  Internal Entry Number for file 80.1

 ;    CDT  Code Set Versioning Date

 ;   .ARY  Array of MDCs passed by reference (required)

 ;    FMT  Output Format (optional)

 ;

 ;           0   Boolean value only (default)

 ;           1   2 piece "^" delimited string

 ;                  1   Boolean value

 ;                  2   String of matching MDCs delimited by ";"

 ; Output:

 ;

 ;  $$MDCT  Boolean value

 ;

 ;           0  The ICD Procedure code identified by IEN

 ;              does not include any of the MDCs passed 

 ;              in .ARY(MDC) on the date specified (CDT)

 ;

 ;           1  The ICD Procedure code identified by IEN 

 ;              includes one or more of the MDCs passed

 ;              in .ARY(MDC) on the date specified (CDT)

 ;

 N FY,FYI,I,MD,MDC,OK,STR

 S IEN=+($G(IEN)) Q:'$D(^ICD0(+IEN,0)) 0

 Q:$P($G(^ICD0(IEN,1)),"^",7)>0 0

 S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT

 S FMT=+($G(FMT)),(STR,MD)="",OK=0 F I=1:1 S MD=$O(ARY(MD)) Q:MD=""  D

 . N FY,FYI,MDC S FY=$O(^ICD0(IEN,2,"B",(+CDT+.001)),-1) Q:FY'?7N

 . S FYI=$O(^ICD0(IEN,2,"B",+FY,0))

 . S MDC=$D(^ICD0(IEN,2,+FYI,1,"B",MD))

 . S:MDC>0 STR=STR_";"_MD

 . S:MDC>0 OK=1

 F  Q:$E(STR,1)'=";"  S STR=$E(STR,2,$L(STR))

 S OK=+OK S:FMT>0&($L(STR)) OK=OK_"^"_STR

 Q OK

MDCD(IEN,MDC,CDT) ; Check for default MDC

 ;

 ; Input:

 ;

 ;    IEN  Internal Entry Number for file 80.1

 ;    MDC  Major Diagnostic Category

 ;    CDT  Code Set Versioning Date (optional)

 ;         If not passed, the first FY is used

 ;

 ; Output:

 ;

 ;   $$MDCD  Boolean value

 ;

 ;           0  MDC Does not exist

 ;           1  MDC Exist

 ;

 N ICDY,ICDM,ICDD,ICDF S ICDY=+($G(IEN)) Q:'$D(^ICD0(+IEN,2,1,1)) 0  S ICDM=$G(MDC) Q:'$L(ICDM) 0

 S ICDD=$G(CDT),ICDF=$O(^ICD0(+ICDY,2,"B",(ICDD+.001)),-1) S:ICDF'?7N ICDF=$O(^ICD0(+ICDY,2,"B",""))

 S ICDF=$O(^ICD0(+ICDY,2,"B",+ICDF,0)) Q:ICDF'>0 $S($D(^ICD0(ICDY,2,1,1,"B",ICDM))>0:1,1:0)

 Q:ICDF>0 $S($D(^ICD0(ICDY,2,+ICDF,1,"B",ICDM))>0:1,1:0)

MDCN(IEN) ; Major Diagnostic Category Name

 ;

 ; Input:

 ;

 ;    IEN    Internal Entry Number for file 80.3

 ;

 ; Output:

 ;

 ;   $$MDCN  Major Diagnostic Category Name

 ;

 ; Replaces ICR 1586

 ; 

 Q $P($G(^ICM(+($G(IEN)),0)),"^",1)

MOR(IEN) ; Major O.R. Procedure

 ;

 ; Input:

 ;

 ;    IEN   Internal Entry Number for file 80.1

 ;

 ; Output:

 ;

 ;   $$MOR  Major O.R. Procedure

 ;

 Q $G(^ICD0(+($G(IEN)),"M"))

 ;

ISVALID(FILE,IEN,CDT) ; Is an ICD code Valid

 ;

 ; Input:

 ; 

 ;    FILE        File or global root

 ;    IEN         Internal Entry Number

 ;    CDT         Effective date to use (default TODAY)

 ;

 ; Output:

 ; 

 ;    $$ISVALID   This is a Boolean value

 ;  

 ;                  1 if the code is valid

 ;                  0 if the code is not valid

 ;

 N ICDO,ICDD,ICDF,ICDT,ICDX,ICDI,ICDR S ICDO=0

 S FILE=$S(FILE="9":80,FILE="0":80.1,1:FILE)

 S ICDD=$P($G(CDT),".",1) S:ICDD'?7N ICDD=$$DT^XLFDT

 S ICDF=$$FILE^ICDEX(FILE) Q:"^80^80.1^"'[("^"_FILE_"^") ICDO

 S ICDR=$$ROOT^ICDEX(FILE),ICDI=+($G(IEN)) Q:+ICDI'>0 ICDO

 Q:'$D(@(ICDR_+ICDI_",0)")) ICDO  S ICDX=$$EXC^ICDEX(ICDF,ICDI) Q:ICDX>0 ICDO

 S ICDT=$$LS^ICDEX(ICDF,ICDI,ICDD) I ICDT>0 S ICDO=1

 Q ICDO

REF(IEN,CDT) ; Return Reference Table

 ;

 ;  Input:

 ;  

 ;    IEN    Internal Entry Number

 ;    CDT    Effective date to use (default TODAY)

 ;

 ;  Output:

 ;  

 ;    $$REF  Table reference associated DRG entry

 ;           or null if not found

 ; 

 N ICDI,ICDD,ICDR,ICDFY,ICDR

 S ICDI=+($G(IEN)) Q:+IEN'>0!('$D(^ICD(IEN,2))) ""

 S (ICDFY,ICDR)="",ICDD=$P($G(CDT),".",1)

 S:ICDD'?7N ICDD=$$DT^XLFDT

 S ICDFY=$O(^ICD(ICDI,2,"B",(+ICDD+.01)),-1)

 S ICDR=$O(^ICD(ICDI,2,"B",+ICDFY,ICDR))

 S ICDR=$P($G(^ICD(ICDI,2,+ICDR,0)),U,3)

 Q ICDR

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICDEXD2   10093     printed  Feb 18, 2025@23:16:59                                                                                                                                                                                                    Page 2

ICDEXD2   ;SLC/KER - ICD Extractor - DRG APIs (cont) ;12/19/2014

 +1       ;;18.0;DRG Grouper;**57,67,82**;Oct 20, 2000;Build 21

 +2       ;               

 +3       ; Global Variables

 +4       ;    ^ICDS(              N/A

 +5       ;               

 +6       ; External References

 +7       ;    $$DT^XLFDT          ICR  10103

 +8       ;    $$FMADD^XLFDT       ICR  10103

 +9       ;    $$FMTE^XLFDT        ICR  10103

 +10      ;    ^%DT                ICR  10003

 +11      ;    ^DIR                ICR  10026

 +12      ;               

 +13       QUIT 

MD(FILE,IEN,CDT,ARY,FLAG) ; MDC DRGs

 +1       ;

 +2       ; Input

 +3       ;

 +4       ;    FILE   File Number/Identifier

 +5       ;    IEN    Internal entry in file

 +6       ;    CDT    Code Set Versioning Date

 +7       ;   .ARY    Array name passed by reference

 +8       ;    FLAG   Flag   I=Internal (default)

 +9       ;                  E=External

 +10      ;

 +11      ; Output

 +12      ;

 +13      ;   ICD Procedures file 80.1 (multiple MDC)

 +14      ;   

 +15      ;      ARY(<fiscal year>,<MDC>)=DRG^;FY;STA

 +16      ;      ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA

 +17      ;   

 +18      ;      If Flag contains "E"

 +19      ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 +20      ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 +21      ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 +22      ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 +23      ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 +24      ;      ARY(<fiscal year>,"E","FY")=External FY

 +25      ;   

 +26      ;   ICD Diagnosis file 80 (single MDC)

 +27      ;   

 +28      ;      ARY(<fiscal year>,<MDC>)="DRG^DRG^;FY;STA

 +29      ;   

 +30      ;      If Flag contains "E"

 +31      ;      ARY(<fiscal year>,"E",<MDC>)=MDC Name

 +32      ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 +33      ;      ARY(<fiscal year>,"E",<MDC>,<DRG>)=DRG Name

 +34      ;      ARY(<fiscal year>,"E","FY")=External FY

 +35      ;   

 +36      ;   NOTE:  If no Fiscal Year found for the input 

 +37      ;   date then the first (earliest) Fiscal Year is 

 +38      ;   used.

 +39      ;

 +40       NEW DRG,FY,FYIEN,MDC,MDCIEN,MY,MYIEN,ROOT,STA,STR

           SET FLAG=$GET(FLAG)

           if '$LENGTH(FLAG)

               SET FLAG="I"

 +41       SET FILE=$GET(FILE)

           if FILE=9!(FILE["ICD9")

               SET FILE=80

           if FILE=0!(FILE["ICD0")

               SET FILE=80.1

 +42       if "^80^80.1^"'[("^"_FILE_"^")

               QUIT "-1;Invalid file selected"

 +43       SET IEN=+($GET(IEN))

           SET CDT=$PIECE($GET(CDT),".",1)

 +44       SET ROOT=$$ROOT^ICDEX(FILE)

           if CDT'?7N

               SET CDT=$$DT^XLFDT

 +45       if '$LENGTH(ROOT)

               QUIT "-1;Invalid file selected"

 +46       KILL ARY

           IF FILE=80.1

               Begin DoDot:1

 +47               SET STA=1

                   SET FY=$ORDER(^ICD0(IEN,2,"B",(CDT+.001)),-1)

 +48               if FY'?7N

                       SET STA=0

                       SET FY=$ORDER(^ICD0(IEN,2,"B",""))

                   if FY'?7N

                       QUIT 

 +49               SET FYIEN=$ORDER(^ICD0(IEN,2,"B",+$GET(FY),0))

                   if +FYIEN'>0

                       QUIT 

 +50               SET MDC=0

                   FOR 

                       SET MDC=$ORDER(^ICD0(IEN,2,FYIEN,1,"B",MDC))

                       if '$LENGTH(MDC)

                           QUIT 

                       Begin DoDot:2

 +51                       SET MDCIEN=0

                           FOR 

                               SET MDCIEN=$ORDER(^ICD0(IEN,2,FYIEN,1,"B",MDC,MDCIEN))

                               if +MDCIEN'>0

                                   QUIT 

                               Begin DoDot:3

 +52                               SET STR=""

                                   SET DRG=""

 +53                               FOR 

                                       SET DRG=$ORDER(^ICD0(IEN,2,FYIEN,1,MDCIEN,1,"B",DRG))

                                       if '$LENGTH(DRG)

                                           QUIT 

                                       SET STR=STR_DRG_"^"

                               End DoDot:3

 +54                       SET ARY(FY,MDC)=STR_";"_FY_";"_STA

 +55                       IF FLAG["E"

                               Begin DoDot:3

 +56                               NEW ED,EMDC,DRGI,IDRG,DRGOUT

 +57                               SET ED=$$FMTE^XLFDT(FY,"5DZ")

                                   SET EMDC=$PIECE($GET(^ICM(+MDC,0)),"^",1)

 +58                               SET ARY(FY,"E","FY")=ED

                                   SET ARY(FY,"E",MDC)=EMDC

 +59                               FOR DRGI=1:1

                                       if '$LENGTH($PIECE($GET(STR),"^",DRGI))

                                           QUIT 

                                       Begin DoDot:4

 +60                                       NEW IDRG,DRGOUT

                                           SET IDRG=$PIECE($GET(STR),"^",DRGI)

                                           if +IDRG'>0

                                               QUIT 

 +61                                       KILL DRGOUT

                                           DO DRGD^ICDGTDRG(IDRG,"DRGOUT",,$GET(CDT))

 +62                                       if $LENGTH($GET(DRGOUT(1)))&(+DRGI>0)

                                               SET ARY(FY,"E",MDC,IDRG)=$GET(DRGOUT(1))

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +63       IF FILE=80

               Begin DoDot:1

 +64               SET STA=1

                   SET FY=$ORDER(^ICD9(IEN,3,"B",(CDT+.001)),-1)

 +65               if FY'?7N

                       SET STA=0

                       SET FY=$ORDER(^ICD9(IEN,3,"B",""))

                   if FY'?7N

                       QUIT 

 +66               SET MY=$ORDER(^ICD9(IEN,4,"B",(FY+.001)))

 +67               if MY'?7N

                       SET MY=$ORDER(^ICD9(IEN,4,"B",""))

 +68               SET MYIEN=$ORDER(^ICD9(IEN,4,"B",+$GET(MY),0))

 +69               SET MDC=$PIECE($GET(^ICD9(IEN,4,+MYIEN,0)),"^",2)

 +70               SET FYIEN=$ORDER(^ICD9(IEN,3,"B",+$GET(FY),0))

                   if +FYIEN'>0

                       QUIT 

 +71               SET STR=""

                   SET DRG=""

 +72               FOR 

                       SET DRG=$ORDER(^ICD9(IEN,3,FYIEN,1,"B",DRG))

                       if '$LENGTH(DRG)

                           QUIT 

                       SET STR=STR_DRG_"^"

 +73               IF +MDC'>0

                       SET MDC=$$DRGMDC^ICDEXD(+STR)

 +74               SET ARY(FY,MDC)=STR_";"_FY_";"_STA

 +75               IF FLAG["E"

                       Begin DoDot:2

 +76                       NEW ED,EMDC,DRGI,IDRG,DRGOUT

 +77                       SET ED=$$FMTE^XLFDT(FY,"5DZ")

                           SET EMDC=$PIECE($GET(^ICM(+MDC,0)),"^",1)

 +78                       SET ARY(FY,"E","FY")=ED

                           SET ARY(FY,"E",MDC)=EMDC

 +79                       FOR DRGI=1:1

                               if '$LENGTH($PIECE($GET(STR),"^",DRGI))

                                   QUIT 

                               Begin DoDot:3

 +80                               NEW IDRG,DRGOUT

                                   SET IDRG=$PIECE($GET(STR),"^",DRGI)

                                   if +IDRG'>0

                                       QUIT 

 +81                               KILL DRGOUT

                                   DO DRGD^ICDGTDRG(IDRG,"DRGOUT",,$GET(CDT))

 +82                               if $LENGTH($GET(DRGOUT(1)))&(+DRGI>0)

                                       SET ARY(FY,"E",MDC,IDRG)=$GET(DRGOUT(1))

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +83       QUIT 

VMDCDX(IEN,CDT) ; Get versioned MDC for Diagnosis Code

 +1       ;

 +2       ; Input

 +3       ;

 +4       ;    IEN    Internal Entry Number file 80

 +5       ;    CDT    Code Set Versioning Date

 +6       ;

 +7       ; Output

 +8       ;

 +9       ;   $$VMDCDX  Versioned MDC

 +10      ;

 +11       NEW ICDI,ICDD,ICDS,ICDM,ICDY

           SET ICDI=+($GET(IEN))

           if '$DATA(^ICD9(ICDI,4,"B"))

               QUIT ""

 +12       SET ICDS=$PIECE($GET(^ICD9(+ICDI,1)),"^",1)

           SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)

 +13       SET (ICDM,ICDY)=""

           SET ICDY=$ORDER(^ICD9(+ICDI,4,"B",(ICDD+.0001)),-1)

 +14       SET ICDM=$ORDER(^ICD9(ICDI,4,"B",+ICDY,ICDM))

 +15       QUIT $PIECE($GET(^ICD9(ICDI,4,+ICDM,0)),U,2)

VMDCOP(IEN,MDC,CDT) ; Get versioned MDC for Op/Pro ICD code from previous years

 +1       ;

 +2       ; Input

 +3       ;

 +4       ;    IEN    Internal Entry Number file 80.1

 +5       ;    MDC    Major Diagnostic Category

 +6       ;    CDT    Code Set Versioning Date

 +7       ;

 +8       ; Output

 +9       ;

 +10      ;   $$VMDCOP  4 piece "^" delimited string

 +11      ;

 +12      ;             1   Fiscal Year  Fileman format

 +13      ;             2   MDC          Pointer to file 80.3

 +14      ;             3   Fiscal Year  pointer to sub-file 80.171

 +15      ;                              (formerly known as DADRGFY)

 +16      ;             4   MDC          pointer to sub-file 80.1711

 +17      ;                                (formerly known as DAMDC)

 +18      ;

 +19       NEW ICDI,ICDC,ICDD,ICDO,ICDY,ICDM,ICDS

           SET ICDI=+($GET(IEN))

           if '$DATA(^ICD0(ICDI,2,"B"))

               QUIT ""

 +20       SET ICDC=$GET(MDC)

           if '$LENGTH(MDC)

               QUIT ""

           SET ICDS=$PIECE($GET(^ICD0(+ICDI,1)),"^",1)

 +21       SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)

           SET (ICDM,ICDY)=""

 +22       SET ICDD=ICDD+.0001

           FOR 

               SET ICDD=$ORDER(^ICD0(ICDI,2,"B",ICDD),-1)

               if 'ICDD!(ICDM>0)

                   QUIT 

               Begin DoDot:1

 +23               SET ICDY=$ORDER(^ICD0(ICDI,2,"B",+$GET(ICDD),ICDY))

                   SET ICDO=ICDD

 +24               SET ICDM=$ORDER(^ICD0(ICDI,2,+ICDY,1,"B",ICDC,ICDM))

               End DoDot:1

 +25       if '$LENGTH($GET(ICDO))

               QUIT ""

 +26       QUIT (ICDO_"^"_ICDC_"^"_ICDY_"^"_ICDM)

 +27      ;

MDCG(IEN,CDT,ARY) ; Set up ICDMDC() array

 +1       ;

 +2       ; Input

 +3       ;

 +4       ;    IEN    ICD Diagnosis (IEN)

 +5       ;    CDT    Code Set Versioning Date

 +6       ;   .ARY    Array name passed by reference

 +7       ;

 +8       ; Output

 +9       ;

 +10      ;    ARY    Array listing MDCs for all DRGs

 +11      ;

 +12      ;      ARY=MDC

 +13      ;      ARY(MDC)=""

 +14      ;

 +15       NEW I,ICDC,ICDO,ICDTMP,ICDS,ICDD,DRGS

           SET IEN=$GET(IEN)

           if +IEN'>0

               QUIT 

           SET ICDS=$PIECE($GET(^ICD9(+IEN,1)),"^",1)

 +16       SET ICDD=$$DTBR^ICDEX($GET(CDT),0,ICDS)

           if '$LENGTH(IEN)

               QUIT 

           SET ICDO=$GET(ARY)

           KILL ARY

           if $LENGTH(ICDO)

               SET ARY=ICDO

 +17       SET ICDTMP=$$GETDRG^ICDEX(80,IEN,ICDD)

           if '$PIECE(ICDTMP,";",3)

               QUIT 

           SET DRGS=$PIECE(ICDTMP,";")

 +18       FOR I=1:1

               if '$LENGTH($PIECE(DRGS,"^",I))

                   QUIT 

               if '$PIECE(DRGS,"^",I)

                   QUIT 

               Begin DoDot:1

 +19               NEW DRG,MDC

                   SET DRG=$PIECE(DRGS,"^",I)

                   if DRG=""

                       QUIT 

                   SET MDC=$PIECE($$DRG^ICDGTDRG(DRG,ICDD),"^",5)

                   if MDC=""

                       QUIT 

                   SET ARY(MDC)=""

               End DoDot:1

 +20       QUIT 

MDCT(IEN,CDT,ARY,FMT) ; For Multiple MDC DX Codes

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ;    IEN  Internal Entry Number for file 80.1

 +5       ;    CDT  Code Set Versioning Date

 +6       ;   .ARY  Array of MDCs passed by reference (required)

 +7       ;    FMT  Output Format (optional)

 +8       ;

 +9       ;           0   Boolean value only (default)

 +10      ;           1   2 piece "^" delimited string

 +11      ;                  1   Boolean value

 +12      ;                  2   String of matching MDCs delimited by ";"

 +13      ; Output:

 +14      ;

 +15      ;  $$MDCT  Boolean value

 +16      ;

 +17      ;           0  The ICD Procedure code identified by IEN

 +18      ;              does not include any of the MDCs passed 

 +19      ;              in .ARY(MDC) on the date specified (CDT)

 +20      ;

 +21      ;           1  The ICD Procedure code identified by IEN 

 +22      ;              includes one or more of the MDCs passed

 +23      ;              in .ARY(MDC) on the date specified (CDT)

 +24      ;

 +25       NEW FY,FYI,I,MD,MDC,OK,STR

 +26       SET IEN=+($GET(IEN))

           if '$DATA(^ICD0(+IEN,0))

               QUIT 0

 +27       if $PIECE($GET(^ICD0(IEN,1)),"^",7)>0

               QUIT 0

 +28       SET CDT=$GET(CDT)

           if CDT'?7N

               SET CDT=$$DT^XLFDT

 +29       SET FMT=+($GET(FMT))

           SET (STR,MD)=""

           SET OK=0

           FOR I=1:1

               SET MD=$ORDER(ARY(MD))

               if MD=""

                   QUIT 

               Begin DoDot:1

 +30               NEW FY,FYI,MDC

                   SET FY=$ORDER(^ICD0(IEN,2,"B",(+CDT+.001)),-1)

                   if FY'?7N

                       QUIT 

 +31               SET FYI=$ORDER(^ICD0(IEN,2,"B",+FY,0))

 +32               SET MDC=$DATA(^ICD0(IEN,2,+FYI,1,"B",MD))

 +33               if MDC>0

                       SET STR=STR_";"_MD

 +34               if MDC>0

                       SET OK=1

               End DoDot:1

 +35       FOR 

               if $EXTRACT(STR,1)'=";"

                   QUIT 

               SET STR=$EXTRACT(STR,2,$LENGTH(STR))

 +36       SET OK=+OK

           if FMT>0&($LENGTH(STR))

               SET OK=OK_"^"_STR

 +37       QUIT OK

MDCD(IEN,MDC,CDT) ; Check for default MDC

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ;    IEN  Internal Entry Number for file 80.1

 +5       ;    MDC  Major Diagnostic Category

 +6       ;    CDT  Code Set Versioning Date (optional)

 +7       ;         If not passed, the first FY is used

 +8       ;

 +9       ; Output:

 +10      ;

 +11      ;   $$MDCD  Boolean value

 +12      ;

 +13      ;           0  MDC Does not exist

 +14      ;           1  MDC Exist

 +15      ;

 +16       NEW ICDY,ICDM,ICDD,ICDF

           SET ICDY=+($GET(IEN))

           if '$DATA(^ICD0(+IEN,2,1,1))

               QUIT 0

           SET ICDM=$GET(MDC)

           if '$LENGTH(ICDM)

               QUIT 0

 +17       SET ICDD=$GET(CDT)

           SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",(ICDD+.001)),-1)

           if ICDF'?7N

               SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",""))

 +18       SET ICDF=$ORDER(^ICD0(+ICDY,2,"B",+ICDF,0))

           if ICDF'>0

               QUIT $SELECT($DATA(^ICD0(ICDY,2,1,1,"B",ICDM))>0:1,1:0)

 +19       if ICDF>0

               QUIT $SELECT($DATA(^ICD0(ICDY,2,+ICDF,1,"B",ICDM))>0:1,1:0)

MDCN(IEN) ; Major Diagnostic Category Name

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ;    IEN    Internal Entry Number for file 80.3

 +5       ;

 +6       ; Output:

 +7       ;

 +8       ;   $$MDCN  Major Diagnostic Category Name

 +9       ;

 +10      ; Replaces ICR 1586

 +11      ; 

 +12       QUIT $PIECE($GET(^ICM(+($GET(IEN)),0)),"^",1)

MOR(IEN)  ; Major O.R. Procedure

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ;    IEN   Internal Entry Number for file 80.1

 +5       ;

 +6       ; Output:

 +7       ;

 +8       ;   $$MOR  Major O.R. Procedure

 +9       ;

 +10       QUIT $GET(^ICD0(+($GET(IEN)),"M"))