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

ICDJC3.m

Go to the documentation of this file. 
  1. ICDJC3 ;ALB/ARH - DRG GROUPER CALCULATOR 2015 - DRG SELECT ;05/26/2016
  1.  ;;18.0;DRG Grouper;**89,97**;Oct 20, 2000;Build 5
  1.  ;
  1.  ; DRG Calcuation for re-designed grouper ICD-10 2015, continuation
  1.  ;
  1.  ;
  1. DRGLS(ICDDATE,PRATT,DXATT,CDSET,DRGARR) ; get all possible satisfied DRGs and their MCC/CC defined by the event diagnosis, procedures and attributes
  1.  ; DRGs are selected based on Code Sets, defined by the event diagnosis and procedures
  1.  ; each DRG may have one or more sets of Code Sets (Cases) that lead to the DRG
  1.  ; 
  1.  ; selected DRGs have at least one DRG Case with all required Code Sets defined and following criteria met:
  1.  ; a DRGs MDC must match the MDC of the events Primary diagnosis, except DRG MDCs 00 and 99
  1.  ; a Medical DRG may not have an event OR procedure unless it is specifically assigned to the Case Code Set
  1.  ; if a DRG that is a member of an Exclusive MDC has a Case initially satisfied then no General MDC DRG is allowed
  1.  ; if a DRG Case includes an 'EXCEPT' Code Set (Set or Case level), that code set must not be defined by the event
  1.  ; if a DRG Case requires Any OR procedure, it may not be satisfied by a code used to satisfy any other code set
  1.  ; if a DRG Case requires a Secondary Dx then that Dxs MCC/CC may not affect the MCC/CC designation of that DRG
  1.  ; when this occurs the MCC/CC applied to that specific DRG is updated and may be different than the event MCC/CC
  1.  ;
  1.  ; Input:   PRATT  - event Procedure Attributes array
  1.  ;          DXATT  - event Diagnosis Attributes array
  1.  ;          CDSET  - Code Sets defined by event Diagnosis and Procedures array
  1.  ; Output:  DRGARR - array of DRGs (83.1) with at least one Case (83.2) defined by event Code Sets and attributes
  1.  ;          DRGARR(drg ifn) = MCC or CC or null - DRG valid for event, applicable MCC/CC (event or DRG specific)
  1.  ;          DRGARR(drg ifn, case ifn) [ 1 if Case is valid for event and selects the DRG
  1.  ;          DRGARR(drg ifn, case ifn) [ 2 ^ MCC or CC or null if Case is valid for event and selects the DRG,
  1.  ;                                      with a DRG specific MCC/CC that overrides the event MCC/CC
  1.  ;          DRGARR(drg ifn, case ifn) [ 3 if there are any unassigned Operating Room Procedures for the Case
  1.  N SETIFN,CSEIFN,DRGIFN,DRG0,MDCIFN,MDC0,MDCTYP,DRGCFND,CASEFND,RESET,ARRCSE,ARRDRG
  1.  S DXATT=$G(DXATT),PRATT=$G(PRATT) K DRGARR
  1.  ;
  1.  ; get list of all potential DRGs: for each satified code set, find all cases, then for those cases find all drgs
  1.  S SETIFN=0 F  S SETIFN=$O(CDSET(SETIFN)) Q:'SETIFN  D
  1.  . S CSEIFN=0 F  S CSEIFN=$O(^ICDD(83.2,"ACS",SETIFN,CSEIFN)) Q:'CSEIFN  D
  1.  .. S DRGIFN=0 F  S DRGIFN=$O(^ICDD(83.1,"ACE",CSEIFN,DRGIFN)) Q:'DRGIFN  S ARRDRG(DRGIFN)=""
  1.  ;
  1.  ; for each potential DRG check that all criteria is met and determine if any of its individual Cases are satisfied
  1.  S DRGIFN=0 F  S DRGIFN=$O(ARRDRG(DRGIFN)) Q:'DRGIFN  D
  1.  . S DRG0=$G(^ICDD(83.1,DRGIFN,0)) S MDCIFN=+$P(DRG0,U,2),MDC0=$G(^ICDD(83,MDCIFN,0)),MDCTYP=$P(MDC0,U,4)
  1.  . ;
  1.  . I '$$DRGACT(+DRG0,$G(ICDDATE)) Q  ; is DRG active
  1.  . ;
  1.  . I $P(MDC0,U,2)'="00",$P(MDC0,U,2)'="99",$P(DXATT,U,2)'[$P(MDC0,U,2) Q  ; DRG MDC must match Primary Dx MDC
  1.  . ;
  1.  . D GETCSE(DRGIFN,$G(ICDDATE),.ARRCSE) ; get active Cases associated with the DRG
  1.  . ;
  1.  . ; for each Case associated with a potential DRG, determine if it is defined by the event and meets criteria
  1.  . S CSEIFN=0 F  S CSEIFN=$O(ARRCSE(CSEIFN)) Q:'CSEIFN  D
  1.  .. ;
  1.  .. S CASEFND=$$CSESET(MDCIFN,CSEIFN,.CDSET,.DXATT,.PRATT,.DRGCFND) ; determine if case and criteria satisfied
  1.  .. ;
  1.  .. I MDCTYP=1,+DRGCFND S ARRDRG=1 ; DRGs MDC Type is Exclusive and DRGs Case code sets satisfied, MDC Exclusive applies
  1.  .. ;
  1.  .. I +CASEFND[3,$P(DRG0,U,4)="M" Q  ; medical DRGs should not have OR procedures
  1.  .. ;
  1.  .. S ARRDRG(DRGIFN)=MDCTYP S ARRDRG(DRGIFN,CSEIFN)=CASEFND ; DRGs MDC Type and Case Results
  1.  ;
  1.  ; for each potential DRG that met all selection criteria then create the selected DRG list with Dx Secondary MCC/CC
  1.  S DRGIFN=0 F  S DRGIFN=$O(ARRDRG(DRGIFN)) Q:'DRGIFN  S RESET=0 D
  1.  . S CSEIFN=0 F  S CSEIFN=$O(ARRDRG(DRGIFN,CSEIFN)) Q:'CSEIFN  D
  1.  .. ;
  1.  .. I +$G(ARRDRG),ARRDRG(DRGIFN)>1 Q  ; MDC Exclusive applies, reject DRGs in General MDCs
  1.  .. ;
  1.  .. S CASEFND=ARRDRG(DRGIFN,CSEIFN) Q:'CASEFND  ; all criteria met and at least one DRG Case satisfied or reject
  1.  .. ;
  1.  .. S DRGARR(DRGIFN,CSEIFN)=CASEFND
  1.  .. S DRGARR(DRGIFN)=$S(+CASEFND[2&'RESET:$P(CASEFND,U,2),1:$P(DXATT,U,1)) I +CASEFND'[2 S RESET=1 ; 2nd Dx MCC/CC
  1.  ;
  1.  Q
  1.  ;
  1. DRGACT(DRG,DATE) ; get the status of the DRG on a date  DRG STATUS (#80.2,66,.03)
  1.  ; input:  DRG - ptr to 80.2, DATE - date to determine status
  1.  ; output: return true if the DRG is active on the date
  1.  N DRGSB,DRGSTAT S (DRGSB,DRGSTAT)=0 I '$G(DATE) S DATE=DT
  1.  I +$G(DRG) S DATE=DATE+.0001 S DATE=+$O(^ICD(+DRG,66,"B",DATE),-1) S DRGSB=$O(^ICD(+DRG,66,"B",+DATE,0))
  1.  I +DRGSB S DRGSTAT=+$P($G(^ICD(+DRG,66,DRGSB,0)),U,3)
  1.  Q DRGSTAT
  1.  ;
  1. GETCSE(DRGIFN,DATE,ARRCSE) ; get all active Cases associated with the DRG (83.1,10)
  1.  ; input:  DRGIFN - ptr to mdc drg (83.1)
  1.  ; output: ARRCSE(case ifn (83.2)) = DRGIFN - array of active Cases (83.2) linked to the DRG (83.1)
  1.  N IX,LINE,BEGIN,END S DRGIFN=+$G(DRGIFN) K ARRCSE I '$G(DATE) S DATE=DT
  1.  ;
  1.  S IX=0 F  S IX=$O(^ICDD(83.1,DRGIFN,10,IX)) Q:'IX  D
  1.  . S LINE=$G(^ICDD(83.1,DRGIFN,10,IX,0)) Q:'LINE
  1.  . S BEGIN=$P(LINE,U,1),END=$P(LINE,U,2) I 'END S END=9999999
  1.  . I DATE'<BEGIN,DATE'>END S ARRCSE(+$P(LINE,U,3))=DRGIFN
  1.  Q
  1.  ;
  1. CSESET(MDCIFN,CSEIFN,CDSET,DXATT,PRATT,DRGCFND) ; determine if a Case is fully satisfied by the event
  1.  ; all Code Sets required by a Case have event codes assigned (CDSET) and satisfy the criteria
  1.  ; input:  MDCIFN - ptr to DRGs MDC (83),  CSEIFN - ptr to a Case (83.2)
  1.  ; output: return true if all the code sets for the case have event codes assigned and meet the criteria
  1.  ;         1 if all case codes sets and criteria satisfied, MCC/CC not affected
  1.  ;         3 if any Operating Room Procedures unassigned to a case code set
  1.  ;         2 ^ MCC or CC or null if all case code sets and criteria satisfied and reset the MCC/CC for the DRG
  1.  ;         DRGCFND returns true if the case is initially satisfied before screening for extra/unassigned OR procedures
  1.  ; a code set identified as EXCEPT, at case or set level, invalidates the case, unless AnyOR overrides it
  1.  ; the codes used to satisfy the ANY OR Procedure Code Set must not be used to satisfy any of the cases other code sets
  1.  ; clusters apply within the MDC of its Set and if no other procedure is necessary to select the case
  1.  ; therefore a cluster with members incompletely assigned to the case may override the selection
  1.  ; if a Secondary Diagnosis is used to select the DRG then its MCC/CC are removed from the DRGs MCC/CC
  1.  N IX,LINE,SETIFN,SET0,LINK,LNKSET,EXCEPT,ANYOR,EXTRAOR,DXSND,ARRSET,FND S CSEIFN=+$G(CSEIFN) S (FND,DRGCFND)=0
  1.  ;
  1.  ; get all code sets required by a Case, add linked sets with codes assigned so all criteria can be applied
  1.  S IX=0 F  S IX=$O(^ICDD(83.2,CSEIFN,10,IX)) Q:'IX  D
  1.  . S LINE=$G(^ICDD(83.2,CSEIFN,10,IX,0)),SETIFN=+LINE S SET0=$G(^ICDD(83.3,SETIFN,0))
  1.  . ;
  1.  . S ARRSET(SETIFN)=LINE
  1.  . I $P(SET0,U,6)>3 S LINK=$P(SET0,U,7) I LINK'="" D  ; unpack linked sets
  1.  .. S LNKSET=0 F  S LNKSET=$O(^ICDD(83.3,"ACSL",LINK,LNKSET)) Q:'LNKSET  I $O(CDSET(LNKSET,0)) S ARRSET(LNKSET)=LINE
  1.  ;
  1.  S (FND,ANYOR,DXSND)=0 S SETIFN=$O(^ICDD(83.3,"ACSC",1,0)) I $D(ARRSET(SETIFN)) S ANYOR=1 ; ANY OPERATING ROOM PROCEDURE
  1.  ;
  1.  ; for each Code Set required by the Case, check if it is defined for the event and passes all criteria
  1.  S SETIFN=0 F  S SETIFN=$O(ARRSET(SETIFN)) Q:'SETIFN  D  Q:'FND
  1.  . S LINE=ARRSET(SETIFN) S SET0=$G(^ICDD(83.3,SETIFN,0))
  1.  . I $P(SET0,U,3)="DX",$P(SET0,U,4)'="P" S DXSND=1 ; a specific secondary dx is required for set
  1.  . ;
  1.  . S FND=1
  1.  . ;
  1.  . S EXCEPT=0 I ($P(LINE,U,2)=1)!($P(SET0,U,5)=1) S EXCEPT=1 I '$D(CDSET(SETIFN)) Q  ; code set except not defined
  1.  . I EXCEPT I ($P(SET0,U,3)'="PR")!('ANYOR) S FND=0 Q  ; code set except exists, may be overriden by Any OR Procedure
  1.  . ;
  1.  . I '$D(CDSET(SETIFN)) S FND=0 Q  ; code set required for case is not found
  1.  ;
  1.  ; if a Case is selected by individual Code Sets, check Case for relationships between Code Sets
  1.  ;
  1.  S DRGCFND=FND ; codes sets and case initially satisfied
  1.  ;
  1.  I FND S EXTRAOR=$$PRCOR($G(MDCIFN),.ARRSET,.CDSET,.PRATT) I +EXTRAOR S FND=FND_3 ; OR Procedures unassigned
  1.  ;
  1.  I FND,ANYOR,'EXTRAOR S FND=0 ; No OR Procedure unassigned, fails ANY OR set
  1.  ;
  1.  I FND,'$$PRCLR($G(MDCIFN),.ARRSET,.CDSET) S FND=0 ; Procedure Cluster incompletely used by a set
  1.  ;
  1.  I FND,DXSND S DXSND=$$DXSND(.ARRSET,.CDSET,.DXATT) I +DXSND=2 S FND=FND_DXSND ; Secondary selects case, reset MCC/CC
  1.  ;
  1.  Q FND
  1.  ;
  1. PRCOR(DRGMDCFN,ARRSET,CDSET,PRATT) ; determine if any event OR Procedures are unassigned or unused
  1.  ; input:  ARRSET(SETIFN) - all code sets that define the case, codes assigned to these sets are considered used
  1.  ; output: returns true if any event OR Procedure codes are unused - not assigned to any of the cases code sets
  1.  ; checks if any OR procedure is unassigned to the Case Sets, excludes generic code sets like Any OR
  1.  ; also excludes as unused members of clusters defined outside the DRGs MDC that are cluster members only, not singles
  1.  N LINE,IX,M0,DRGCAT,DRGMDC,SETIFN,SETCAT,SETMDC,FND,ARRCDX S FND=0
  1.  S M0=$G(^ICDD(83,+$G(DRGMDCFN),0)) S DRGCAT=$P(M0,U,1),DRGMDC=$P(M0,U,2)
  1.  ;
  1.  ; get all event procedure codes assigned to the cases procedure code sets (non-generic)
  1.  S SETIFN=0 F  S SETIFN=$O(ARRSET(SETIFN)) Q:'SETIFN  D
  1.  . S LINE=$G(^ICDD(83.3,SETIFN,0)) I $P(LINE,U,3)="PR",+$P(LINE,U,2) D
  1.  .. S M0=$G(^ICDD(83,+$P(LINE,U,2),0)) S SETCAT=$P(M0,U,1),SETMDC=$P(M0,U,2)
  1.  .. S IX=0 F  S IX=$O(CDSET(SETIFN,IX)) Q:'IX  I (DRGMDC=SETMDC)!($P(CDSET(SETIFN,IX),U,3)) S ARRCDX(IX)=""
  1.  ;
  1.  ; find if any event OR procedure/cluster is not assigned to the case code sets
  1.  S IX=0 F  S IX=$O(PRATT(IX)) Q:'IX  I $P(PRATT(IX),U,7)="O",'$D(ARRCDX(IX)) S FND=1 Q
  1.  ;
  1.  Q FND
  1.  ;
  1. PRCLR(DRGMDCFN,ARRSET,CDSET) ; Cluster/MDC Rule - deterime if a cluster is defined by the event and affects the case
  1.  ; procedures within a cluster must all exist for the cluster to satisfy a set
  1.  ; the cluster applies only within the MDC of its Set and if no other procedure is necessary to select the case
  1.  ; input:  ARRSET(SETIFN) - all code sets that define the case, codes assigned to these sets are considered used
  1.  ; output: returns true (1) if a procedure cluster does not invalidate the set
  1.  ;         returns false (0) if cluster is defined and invalidates the case
  1.  ; if a cluster is defined by the event, it may or may not need to be fully assigned to the case sets
  1.  ; when applied to cases, the clusters individual procedures may be used outside the clusters MDC or if there
  1.  ; are non-cluster procedures necessary to select the case
  1.  ; Cluster/MDC Rule does not apply to MDC 00, single procedures of clusters within MDC 00 may satisfy an MDC 00 set
  1.  N IX,M0,DRGCAT,DRGMDC,SETIFN,SET0,SETCAT,SETMDC,CLSTR,ARRCDX,ARRCLS,FND S FND=1
  1.  S M0=$G(^ICDD(83,+$G(DRGMDCFN),0)) S DRGCAT=$P(M0,U,1),DRGMDC=$P(M0,U,2)
  1.  ;
  1.  I DRGMDC="00" Q 1  ; Cluster/MDC Rule does not apply to clusters in MDC 00
  1.  ;
  1.  ; find event procedures that satisfy the Case procedure Sets, Case MDC and Category
  1.  S SETIFN=0 F  S SETIFN=$O(ARRSET(SETIFN)) Q:'SETIFN  D
  1.  . S SET0=$G(^ICDD(83.3,SETIFN,0)) I $P(SET0,U,3)="PR" S IX=0 F  S IX=$O(CDSET(SETIFN,IX)) Q:'IX  S ARRCDX(IX)=""
  1.  ;
  1.  ; find event procedure clusters in the Case MDC but not assigned to the Case MDC Category (not used)
  1.  I $O(ARRCDX(0)) S SETIFN=0 F  S SETIFN=$O(CDSET(SETIFN)) Q:'SETIFN  D
  1.  . S IX=0 F  S IX=$O(CDSET(SETIFN,IX)) Q:'IX  S CLSTR=$P(CDSET(SETIFN,IX),U,4) I +CLSTR  D
  1.  .. S SET0=$G(^ICDD(83.3,SETIFN,0)) S M0=$G(^ICDD(83,+$P(SET0,U,2),0)) S SETCAT=$P(M0,U,1),SETMDC=$P(M0,U,2)
  1.  .. I SETMDC=DRGMDC,SETCAT'=DRGCAT S ARRCLS(IX)=""
  1.  ;
  1.  ; reject if event cluster is not used to satisfy the Case unless there is also a non-cluster procedure required
  1.  I +FND S IX=0 F  S IX=$O(ARRCLS(IX)) Q:'IX  I '$D(ARRCDX(IX)) S FND=0 ; not all cluster proc defined for event
  1.  I 'FND S IX=0 F  S IX=$O(ARRCDX(IX)) Q:'IX  I '$D(ARRCLS(IX)) S FND=1 ; non-cluster proc defined, overrides cluster
  1.  Q FND
  1.  ;
  1. DXSND(ARRSET,CDSET,DXATT) ; Case Secondary Dx Rule - get updated DRG MCC/CC if a Secondary Dx was used to select the DRG Case
  1.  ; if an event diagnosis is assigned to a cases secondary dx code set then remove its MCC/CC from the DRGs MCC/CC
  1.  ; input:  ARRSET(SETIFN) - all code sets that define the case, codes assigned to these sets are considered used
  1.  ; output: 2 ^ MCC or CC or null - updated DRG MCC/CC
  1.  ;         null if secondary dx code sets did not affect the MCC/CC
  1.  ; if a Secondary Diagnosis is used to select the DRG then its MCC/CC may not be used for the DRGs MCC/CC
  1.  N SETIFN,LINE,IX,NEWMCC,DXCC,FND,ARRCDX S NEWMCC="",FND=""
  1.  ;
  1.  ; get secondary event diagnosis codes assigned to the cases secondary dx code sets
  1.  S SETIFN=0 F  S SETIFN=$O(ARRSET(SETIFN)) Q:'SETIFN  S LINE=$G(^ICDD(83.3,SETIFN,0)) D
  1.  . I $P(LINE,U,3)="DX" S IX=0 F  S IX=$O(CDSET(SETIFN,IX)) Q:'IX  I IX'=$O(DXATT(0)) S ARRCDX(IX)=""
  1.  ;
  1.  ; if an event diagnosis is assigned to a case secondary dx code set then remove its MCC/CC from use on the DRG
  1.  ; recalculate the MCC/CC based on the event diagnosis not assigned to the cases secondary dx code sets
  1.  I $O(ARRCDX(0)) S NEWMCC="" S IX=0 F  S IX=$O(DXATT(IX)) Q:'IX  D  I NEWMCC="MCC" Q
  1.  . S DXCC=$P(DXATT(IX),U,7) I DXCC'="",'$D(ARRCDX(IX)) S NEWMCC=DXCC
  1.  ;
  1.  I $O(ARRCDX(0)),NEWMCC'=$P(DXATT,U,1) S FND=2_U_NEWMCC
  1.  ;
  1.  Q FND