Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICDEXC3

ICDEXC3.m

Go to the documentation of this file. 
  1. ICDEXC3 ;SLC/KER - ICD Extractor - Code APIs (cont) ;04/21/2014
  1.  ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^ICD0("ADS")        N/A
  1.  ;    ^ICD0("AST")        N/A
  1.  ;    ^ICD9("ADS")        N/A
  1.  ;    ^ICD9("AST")        N/A
  1.  ;    ^UTILITY($J)        ICR  10011
  1.  ;               
  1.  ; External References
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;    $$FMTE^XLFDT        ICR  10103
  1.  ;    $$UP^XLFSTR         ICR  10104
  1.  ;    ^DIWP               ICR  10011
  1.  ;               
  1.  Q
  1. VST(FILE,IEN,CDT)     ; Versioned Short Text
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   FILE  Global Root/File #/Coding System/SAB
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VST   Short Text from either file 80 or 80.1
  1.  ;            
  1.  N ICDF,ICDR S ICDR=$$ROOT^ICDEX($G(FILE)) Q:'$L(ICDR) ""
  1.  S ICDF=$$FILE^ICDEX(ICDR) Q:+ICDF'>0 ""
  1.  Q:ICDF=80 $$VSTD($G(IEN),$G(CDT))
  1.  Q:ICDF=80.1 $$VSTP($G(IEN),$G(CDT))
  1.  Q ""
  1. VLT(FILE,IEN,CDT) ; Versioned Long Text
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   FILE  Global Root/File #/Coding System/SAB
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VLT   Long Text (description) from either file 80 or 80.1
  1.  ;            
  1.  N ICDF,ICDR S ICDR=$$ROOT^ICDEX($G(FILE)) Q:'$L(ICDR) ""
  1.  S ICDF=$$FILE^ICDEX(ICDR) Q:+ICDF'>0 ""
  1.  Q:ICDF=80 $$VLTD($G(IEN),$G(CDT))
  1.  Q:ICDF=80.1 $$VLTP($G(IEN),$G(CDT))
  1.  Q ""
  1. VSTD(IEN,CDT)  ; Versioned Short Text (Dx)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VST   Short Text from file 80
  1.  ;            
  1.  N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD9(+ICDI)) ""
  1.  S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""  S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
  1.  S STD=$O(^ICD9("AST",(ICDC_" "),(ICDT+.000001)),-1)
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD9("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),U,2))
  1.  S STD=$O(^ICD9(+ICDI,67,"B",0)) I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD9(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD9(+ICDI,67,+STI,0)),U,2))
  1.  Q $$TRIM($P(ICD0,U,3))
  1. VSTP(IEN,CDT) ; Return versioned Short Text (Proc)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VST   Short Text from file 80.1
  1.  ;            
  1.  N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD0(+ICDI)) ""
  1.  S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""  S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
  1.  S STD=$O(^ICD0("AST",(ICDC_" "),(ICDT+.000001)),-1)
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD0("AST",(ICDC_" "),STD,+ICDI," "),-1),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),U,2))
  1.  S STD=$O(^ICD0(+ICDI,67,"B",0)) I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD0(+ICDI,67,"B",STD,0)),TXT=$$TRIM($P($G(^ICD0(+ICDI,67,+STI,0)),U,2))
  1.  Q $$TRIM($P(ICD0,U,4))
  1. VLTD(IEN,CDT) ; Versioned Description - Long Text (Dx)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VLT   Long Text from file 80
  1.  ;            
  1.  N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
  1.  S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD9(+ICDI)) ""
  1.  S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
  1.  S ICD0=$G(^ICD9(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
  1.  S STD=$O(^ICD9("ADS",(ICDC_" "),(ICDT+.000001)),-1)
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD9("ADS",(ICDC_" "),STD,+ICDI," "),-1)
  1.  .S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),U,1))
  1.  S STD=$O(^ICD9(+ICDI,68,"B",0))
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD9(+ICDI,68,"B",STD,0))
  1.  .S TXT=$$TRIM($P($G(^ICD9(+ICDI,68,+STI,1)),U,1))
  1.  S TXT=$$TRIM($G(^ICD9(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
  1.  Q $$TRIM($P(ICD0,U,3))
  1. VLTP(IEN,CDT) ; Versioned Description - Long Text (Proc)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   IEN   IEN  (required)
  1.  ;   CDT   Date to use to Extract Text (default TODAY)
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   VLT   Long Text from file 80.1
  1.  ;            
  1.  N ICD0,ICDC,ICDI,STD,STI,ICDT,TXT
  1.  S ICDI=+($G(IEN)) Q:+ICDI'>0 ""  Q:'$D(^ICD0(+ICDI)) ""
  1.  S ICDT=$G(CDT) S:'$L(ICDT)!(+ICDT'>0) ICDT=$$DT^XLFDT Q:$P(ICDT,".",1)'?7N ""
  1.  S ICD0=$G(^ICD0(+ICDI,0)),ICDC=$P(ICD0,U,1) Q:'$L(ICDC) ""
  1.  S STD=$O(^ICD0("ADS",(ICDC_" "),(ICDT+.000001)),-1)
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD0("ADS",(ICDC_" "),STD,+ICDI," "),-1)
  1.  .S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),U,1))
  1.  S STD=$O(^ICD0(+ICDI,68,"B",0))
  1.  I +STD>0 D  Q:$L($G(TXT)) $G(TXT)
  1.  .S STI=$O(^ICD0(+ICDI,68,"B",STD,0))
  1.  .S TXT=$$TRIM($P($G(^ICD0(+ICDI,68,+STI,1)),U,1))
  1.  S TXT=$$TRIM($G(^ICD0(+ICDI,1))) Q:$L($G(TXT)) $G(TXT)
  1.  Q $$TRIM($P(ICD0,U,4))
  1. SD(FILE,IEN,CDT,ARY,LEN) ; Short Description (formatted)
  1.  ;            
  1.  ; Input:
  1.  ; 
  1.  ;   IEN   Internal Entry Number (Required)
  1.  ;   FILE  File Number (Required)
  1.  ;   CDT   Date, Default TODAY (Optional)
  1.  ;  .ARY   Array Passed by Reference (Optional)
  1.  ;   LEN   Text Length (15-79, default 60) (Optional) 
  1.  ;   
  1.  ; Output:
  1.  ; 
  1.  ;   $$SD  Short Description OR -1 ^ Error Message
  1.  ;   ARY   Description in segment lengths specified
  1.  ;   
  1.  K ARY N EFF,HIS,NOD,ROOT,TXT S IEN=+($G(IEN)),FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"
  1.  S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT S LEN=+($G(LEN)) S:+LEN'>0 LEN=100
  1.  S:LEN>0&(LEN<15) LEN=15 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
  1.  Q:'$L(ROOT) "-1^File not found"  S (EFF,HIS,TXT)=""
  1.  S NOD="-1^No description found for date "_$$FMTE^XLFDT($G(CDT),"5DZ")
  1.  S EFF=+($O(@(ROOT_+IEN_",67,""B"","_(CDT+.000001)_")"),-1))
  1.  Q:EFF'?7N NOD  S HIS=+($O(@(ROOT_+IEN_",67,""B"","_EFF_","" "")"),-1))
  1.  Q:+HIS'>0 NOD  S TXT=$P($G(@(ROOT_+IEN_",67,"_+HIS_",0)")),"^",2)
  1.  Q:'$L(TXT) NOD  S ARY(1)=TXT D:+LEN>0&(LEN'=100) PAR(.ARY,LEN)
  1.  S IEN=$O(ARY(" "),-1),ARY(0)=+IEN
  1.  S:EFF?7N ARY(0)=$G(ARY(0))_"^"_EFF S IEN=TXT
  1.  Q IEN
  1. LD(FILE,IEN,CDT,ARY,LEN) ; Long Description (formatted)
  1.  ;   
  1.  ; Input:
  1.  ; 
  1.  ;   IEN   Internal Entry Number (Required)
  1.  ;   FILE  File Number (Required)
  1.  ;   CDT   Date, Default TODAY (Optional)
  1.  ;  .ARY   Array Passed by Reference (Optional)
  1.  ;   LEN   Text Length (15-79, default 245) (Optional) 
  1.  ;   
  1.  ; Output:
  1.  ; 
  1.  ;   $$LD  Long Description OR -1 ^ Error Message
  1.  ;   ARY   Description in lengths specified
  1.  ;   
  1.  K ARY N EFF,HIS,NOD,ROOT,TXT S IEN=+($G(IEN)),FILE=$$FILE^ICDEX($G(FILE)) Q:"^80^80.1^"'[("^"_FILE_"^") "-1^File not found"
  1.  S CDT=$G(CDT) S:CDT'?7N CDT=$$DT^XLFDT S LEN=+($G(LEN)) S:+LEN'>0 LEN=300
  1.  S:LEN>0&(LEN<15) LEN=15 S ROOT=$S(FILE=80:"^ICD9(",FILE=80.1:"^ICD0(",1:"")
  1.  Q:'$L(ROOT) "-1^File not found"  S (EFF,HIS,TXT)=""
  1.  S NOD="-1^No long description found for date "_$$FMTE^XLFDT($G(CDT),"5DZ")
  1.  S EFF=+($O(@(ROOT_+IEN_",68,""B"","_(CDT+.000001)_")"),-1)) Q:EFF'?7N NOD
  1.  S HIS=+($O(@(ROOT_+IEN_",68,""B"","_EFF_","" "")"),-1)) Q:+HIS'>0 NOD
  1.  S TXT=$G(@(ROOT_+IEN_",68,"_+HIS_",1)")) Q:'$L(TXT) NOD
  1.  S ARY(1)=TXT D:+($G(LEN))>0&(LEN'=300) PAR(.ARY,LEN)
  1.  S IEN=$O(ARY(" "),-1),ARY(0)=+IEN
  1.  S:EFF?7N ARY(0)=$G(ARY(0))_"^"_EFF S IEN=TXT
  1.  Q IEN
  1. CC(IEN,CDT) ; Complication/Comorbidity (C/C)
  1.  ;
  1.  ; Input
  1.  ; 
  1.  ;   IEN    Internal Entry Number (Required)
  1.  ;   CDT    Date, Default TODAY (Optional)
  1.  ;   
  1.  ; Output
  1.  ; 
  1.  ;   $$CC   A code for C/C or Error
  1.  ;            0   Non-CC
  1.  ;            1   CC
  1.  ;            2   Major CC
  1.  ;           -1 ^ error
  1.  ;           
  1.  N CEFF,CIEN S CDT=$S($G(CDT)?7N:$G(CDT),1:$$DT^XLFDT)
  1.  S CEFF=$O(^ICD9(+$G(IEN),69,"B",(CDT+.000001)),-1)
  1.  Q:CEFF'?7N ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
  1.  S CIEN=$O(^ICD9(+$G(IEN),69,"B",CEFF," "),-1)
  1.  Q:+CIEN'>0 ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
  1.  S IEN=$P(^ICD9(+$G(IEN),69,CIEN,0),U,2)
  1.  Q:'$L(IEN) ("-1^No CC for "_$$FMTE^XLFDT($G(CDT),"5DZ"))
  1.  Q IEN
  1. PAR(ARY,LEN) ; Parse Array
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;  .ARY   Array passed by reference (required)
  1.  ;   LEN   Array String Length
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   ARY   Array parse with string lengths of LEN
  1.  ;
  1.  N %,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,Z,I,IEN,CTR,X
  1.  K ^UTILITY($J,"W") Q:'$D(ARY)  S LEN=+($G(LEN)) S:+LEN'>0 LEN=79
  1.  S DIWL=1,DIWF="C"_+LEN S IEN=0
  1.  F  S IEN=$O(ARY(IEN)) Q:+IEN=0  S X=$G(ARY(IEN)) D ^DIWP
  1.  K ARY S (CTR,IEN)=0 F  S IEN=$O(^UTILITY($J,"W",1,IEN)) Q:+IEN=0  D
  1.  . S ARY(IEN)=$$TRIM($G(^UTILITY($J,"W",1,IEN,0))," "),CTR=CTR+1
  1.  K ^UTILITY($J,"W")
  1.  Q
  1. IEN(CODE,ROOT,SYS) ; Return IEN based on Code, Root and Coding System
  1.  ;
  1.  ; This API is similar to $$CODEABA^ICDEX except it will
  1.  ; also return IENs for codes excluded from lookup and 
  1.  ; VA Local Codes.  Use with caution, and do not use in
  1.  ; any application that requires codes and text to be 
  1.  ; versioned (date sensitive).
  1.  ; 
  1.  ; Input:
  1.  ;
  1.  ;   CODE  ICD Code, either ICD-9 or ICD-10 (required)
  1.  ;   ROOT  File Root (optional)
  1.  ;            ^ICD9( or 80
  1.  ;            ^ICD0( or 80.1
  1.  ;   SYS   Coding System (optional)
  1.  ;           1 = ICD-9 Diagnosis
  1.  ;           2 = ICD-9 Procedure
  1.  ;          30 = ICD-10 Diagnosis
  1.  ;          31 = ICD-10 Procedure
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   IEN   IEN for CODE in ROOT for SYS or -1 if not found
  1.  ;   
  1.  N ICDC,ICDFR,ICDFS,ICDI,ICDIX,ICDR,ICDS,ICDTR,ICDTS,ICDU
  1.  S ICDC=$TR($G(CODE)," ","") Q:'$L(ICDC) -1  Q:ICDC["""" -1
  1.  S ICDS=+($G(SYS)),ICDU=$$UP^XLFSTR(ICDC)
  1.  S ICDR=$$ROOT^ICDEX($G(ROOT))
  1.  I "^ICD9(^ICD0(^"'[("^"_$E(ICDR,2,$L(ICDR))_"^") D
  1.  . N ICDTR,ICDFR S ICDFR="" F ICDTR="^ICD9(","^ICD0(" D  Q:$L(ICDFR)
  1.  . . N ICDIX S ICDIX=" " Q:'$L($O(@(ICDTR_""""_ICDIX_""")")))
  1.  . . F  S ICDIX=$O(@(ICDTR_""""_ICDIX_""")")) Q:'$L(ICDIX)  D  Q:$L(ICDFR)
  1.  . . . I $D(@(ICDTR_""""_ICDIX_""","""_(ICDU_" ")_""")")) S ICDFR=ICDTR
  1.  . S:$L(ICDFR) ICDR=ICDFR
  1.  Q:"^ICD9(^ICD0(^"'[("^"_$E(ICDR,2,$L(ICDR))_"^") -1
  1.  I +($G(ICDS))'>0 D
  1.  . N ICDTS,ICDFS S ICDFS="" S ICDTS=0
  1.  . F  S ICDTS=$O(@(ICDR_"""ABA"","_+ICDTS_")")) Q:+ICDTS'>0  D  Q:ICDFS>0
  1.  . . S:$D(@(ICDR_"""ABA"","_+ICDTS_","""_ICDC_" "")")) ICDFS=ICDTS
  1.  . S:$L(ICDFS) ICDS=ICDFS
  1.  S:+($G(ICDI))'>0&(+ICDS>0) ICDI=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDC_" "","" "")"),-1)
  1.  S:+($G(ICDI))'>0&(+ICDS>0) ICDI=$O(@(ICDR_"""ABA"","_+ICDS_","""_ICDU_" "","" "")"),-1)
  1.  S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""BA"","""_ICDC_" "","" "")"),-1)
  1.  S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""AVA"","""_ICDC_" "","" "")"),-1)
  1.  S:+($G(ICDI))'>0 ICDI=$O(@(ICDR_"""AEXC"","""_ICDC_" "","" "")"),-1)
  1.  Q $S('ICDI:-1,1:ICDI)
  1. TRIM(X,Y) ; Trim Character
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   X     Input String
  1.  ;   Y     Character to Trim (default " ")
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;   X     String without Leading/Trailing character Y
  1.  ;
  1.  S X=$G(X) Q:X="" X  S Y=$G(Y) S:'$L(Y) Y=" "
  1.  F  Q:$E(X,1)'=Y  S X=$E(X,2,$L(X))
  1.  F  Q:$E(X,$L(X))'=Y  S X=$E(X,1,($L(X)-1))
  1.  Q X