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

ICDEXD6.m

Go to the documentation of this file. 
  1. ICDEXD6 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;12/19/2014
  1.  ;;18.0;DRG Grouper;**67**;Oct 20, 2000;Build 1
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^ICDS(              N/A
  1.  ;               
  1.  ; External References
  1.  ;    $$DT^XLFDT          ICR  10103
  1.  ;    $$FMADD^XLFDT       ICR  10103
  1.  ;    $$FMTE^XLFDT        ICR  10103
  1.  ;    ^%DT                ICR  10003
  1.  ;    ^DIR                ICR  10026
  1.  ;               
  1.  Q
  1. UPDX(IEN) ; Unacceptable as Principle DX
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;    IEN   Internal Entry Number for file 80
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$UPDX  Boolean value only (default)
  1.  ;   
  1.  ;            0 No, Code is Acceptable as Principle DX
  1.  ;            1 Yes, Code is Unacceptable as Principle DX
  1.  ;
  1.  N ICDEXC S ICDEXC=$$EXC^ICDEX(80,+($G(IEN))) Q:+ICDEXC>0 1
  1.  Q +($P($G(^ICD9(+($G(IEN)),1)),"^",3))
  1. POAE(X) ; Present on Admission (POA) Exempt
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;    IEN   Internal Entry Number for file 80
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$POAE Boolean value only
  1.  ;   
  1.  ;            0 No, Code is not exempt for POA
  1.  ;            1 Yes, Code is exempt for POA
  1.  ; 
  1.  Q:+($G(X))'>0 0  Q:'$L($G(^ICD9(+($G(IEN)),1))) 0
  1.  Q +($P($G(^ICD9(+($G(IEN)),1)),"^",9))
  1. HAC(X) ; Hospital Acquired Conditions (HACS)
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;    IEN   Internal Entry Number for file 80
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$HAC  Boolean value only
  1.  ;   
  1.  ;            0 No, Code is not a Hospital Acquired Condition
  1.  ;            1 Yes, Code is a Hospital Acquired Condition
  1.  ; 
  1.  Q:+($G(X))'>0 0  Q:'$L($G(^ICD9(+($G(IEN)),1))) 0
  1.  I $D(^ICDHAC("C",+($G(IEN)))) Q 1
  1.  Q 0
  1. EFM(X) ; Convert External Date to FM
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   X      External Date
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$EFM  Internal Fileman Date
  1.  ;
  1.  ; Replaces unsupported $$DGY2K^DGPTOD0(X)
  1.  ;
  1.  N %DT,Y D ^%DT K %DT
  1.  Q Y
  1. FY(X) ;Return FY
  1.  ;
  1.  ; Input:
  1.  ;
  1.  ;   X      Internal Fileman Date
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$FY   FY Year YYYY
  1.  ;
  1.  ; Replaces unsupported $$FY^DGPTOD0(X)
  1.  ; 
  1.  S X=$P($G(X),".",1) Q:$L(X)>7 ""  Q:$E(X,1,5)'?5N ""
  1.  S:$E(X,4,5)>9 X=$E(X,1,3)+1
  1.  Q (17+$E(X))_$E(X,2,3)
  1. DRGN(CODE) ; Return the IEN of DRG
  1.  ;
  1.  ;   Input:  
  1.  ;   
  1.  ;     CODE     DRG code
  1.  ;       
  1.  ;  Output:  
  1.  ;  
  1.  ;     $$DRGN   IEN of DRG code
  1.  ;       
  1.  ;              or 
  1.  ;       
  1.  ;              -1 on error
  1.  ;
  1.  Q:$G(CODE)="" -1
  1.  N COD S COD=+$O(^ICD("B",CODE,0))
  1.  Q $S(COD>0:COD,1:-1)
  1.  Q
  1. DRGC(IEN) ; DRG Code
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;    IEN      Internal Entry Number file 80.2
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;    $$DRGC   Code (field .01)
  1.  ;
  1.  ; Replaces ICR 370
  1.  ; 
  1.  S IEN=+($G(IEN)) Q:'$D(^ICD(+IEN,0)) ""
  1.  Q $P($G(^ICD(+IEN,0)),"^",1)
  1. DRGW(IEN) ; DRG Weighted Work Unit (WWU)
  1.  ;
  1.  ; Input:
  1.  ; 
  1.  ;    IEN      Internal Entry Number file 80.2
  1.  ;
  1.  ; Output:
  1.  ; 
  1.  ;    $$WT     Weight
  1.  ;
  1.  ; Replaces ICR 48
  1.  ; 
  1.  S IEN=+($G(IEN)) Q:'$D(^ICD(+IEN,0)) ""
  1.  Q $P($G(^ICD(+IEN,0)),"^",2)
  1. EFD(X) ; Get Effective date in range (interactive)
  1.  ;
  1.  ; Prompts for Effective Date for DRG grouper
  1.  ; 
  1.  ; The lower boundary for the date is the ICD-9 
  1.  ; implementation date October 1, 1978.
  1.  ; 
  1.  ; The upper boundary for date is either
  1.  ; 
  1.  ;       3 years from the ICD-10 implementation date or
  1.  ;       3 years from TODAY
  1.  ;       
  1.  ;       Whichever is further into the future
  1.  ;
  1.  ; Input:   
  1.  ; 
  1.  ;   None
  1.  ;
  1.  ; Output:
  1.  ;
  1.  ;   $$EFF  3 piece ^ delimited string
  1.  ;   
  1.  ;          1   Date Fileman format         nnnnnnn
  1.  ;          2   Date External Short Format  mm/dd/yyyy
  1.  ;          3   Date External Long Format   Mmm dd, yyyy
  1.  ;
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,ICDH,ICDI,ICDIMP,ICDT,Y
  1.  S ICDT=$$DT^XLFDT,ICDH="",ICDI=0
  1.  F  S ICDI=$O(^ICDS(ICDI)) Q:+ICDI'>0  D
  1.  . N ICDIMP S ICDIMP=$P($G(^ICDS(ICDI,0)),"^",3)
  1.  . S:ICDIMP>ICDH ICDH=ICDIMP
  1.  S:ICDT>ICDH ICDH=ICDT S ICDH=$$FMADD^XLFDT(ICDH,1095)
  1.  S DIR(0)="DAO^2781001:"_ICDH_":AEX"
  1.  S DIR("B")="TODAY",DIR("A")=" Effective Date:  " I ICDH?7N D 
  1.  . S DIR("A")=" Effective Date ("_$$FMTE^XLFDT(2781001,"5Z")
  1.  . S DIR("A")=DIR("A")_" to "_$$FMTE^XLFDT($G(ICDH),"5Z")_"):  "
  1.  S DIR("PRE")="S:X[""?"" X=""??""",(DIR("?"),DIR("??"))="^D EFFH^ICDEXD"
  1.  D ^DIR Q:$D(DIROUT) "^^"  Q:$D(DIRUT) "^"  Q:$D(DTOUT) ""
  1.  S X=Y S:X?7N X=X_"^"_$$FMTE^XLFDT(X,"5Z")_"^"_$$FMTE^XLFDT(X)
  1.  Q X
  1. EFFH ; Effective Date Help
  1.  I $L($G(ICDH)) D
  1.  . W !,?5,"Enter an effective date from ",$$FMTE^XLFDT(2781001,"5Z")
  1.  . W " to ",$$FMTE^XLFDT($G(ICDH),"5Z")
  1.  . W !,?5,"to be used to select or calculated time sensitive data.",!
  1.  W !,?5,"Examples of Valid Dates:"
  1.  W !,?5,"  JAN 20 1980 or 20 JAN 80 or 1/20/57 or 012080"
  1.  W !,?5,"  T   (for TODAY),  T+1 (for TOMORROW),  T+2,  T+7, etc."
  1.  W !,?5,"  T-1 (for YESTERDAY),  T-3W (for 3 WEEKS AGO), etc."
  1.  W !,?5,"If the year is omitted, the computer uses CURRENT YEAR. "
  1.  W !,?5,"Two digit year assumes no more than 20 years in the future,"
  1.  W !,?5," or 80 years in the past."
  1.  Q