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

ICDRGAPI.m

Go to the documentation of this file.
  1. ICDRGAPI ;ALB/JAM - DRG GROUPER APIS ;05/29/12 2:39pm
  1. ;;18.0;DRG Grouper;**64**;Oct 20, 2000;Build 103
  1. ;
  1. ICDID(FILE,ID,CODE) ; Returns value indicating if identifier exist.
  1. ;
  1. ; Input:
  1. ; FILE File to look-up for identifier (required)
  1. ; 80 = File #80
  1. ; 80.1 = File #80.1
  1. ; ID Diagnosis/Procedure code identifier (required)
  1. ; CODE DX IEN or PX IEN (required)
  1. ;
  1. ; Output: Returns an 1, 0 or -1
  1. ; 1 if identifier was found
  1. ; 0 if identifier was not found
  1. ; -1 error^error message
  1. ;
  1. N ICDIDIEN,ICDGBL
  1. I '+$G(FILE) Q "-1^Invalid File"
  1. I $G(ID)="" Q "-1^Missing identifier"
  1. I '+$G(CODE) Q "-1^Invalid IEN"
  1. ;S GBL=$$ROOT^ICDEX(FILE)
  1. ;I "^^ICD9(^^ICD0(^"'["^"_GBL_"^" Q "-1^Invalid Global"
  1. S ICDGBL=$S(FILE=80:"^ICD9(",1:"^ICD0(")
  1. S ICDIDIEN=$$IDIEN(FILE,ID) I '+ICDIDIEN Q "-1^Invalid identifier"
  1. I $D(@(ICDGBL_CODE_",73,""B"","_ICDIDIEN_")")) Q 1
  1. Q 0
  1. ;
  1. IDIEN(FILE,ID) ;get IEN for identifier
  1. I FILE=80 Q $O(^ICDID("B",ID,""))
  1. E Q $O(^ICDIP("B",ID,""))
  1. Q
  1. ;
  1. ICDIDS(FILE,CODE,ARY) ; Returns an array of identifiers.
  1. ;
  1. ; Input:
  1. ; FILE File to look-up for identifier (required)
  1. ; 80 = File #80
  1. ; 80.1 = File #80.1
  1. ; CODE DX IEN or PX IEN (required)
  1. ; ARY Array Name passed by reference (required)
  1. ;
  1. ; Output: Return S an 1, 0 or -1
  1. ; 1 if identifier was found
  1. ; 0 if identifier was not found
  1. ; -1 error^error message
  1. ;
  1. N ICDGBL,ICDX,ICDC,ICDID,ICDGBLT,ICDGBLID
  1. I '+$G(FILE) Q "-1^Invalid File"
  1. I '+$G(CODE) Q "-1^Invalid IEN"
  1. S ICDGBL=$P($$ROOT^ICDEX(FILE),"(",1)
  1. I "^^ICD9^^ICD0^"'["^"_ICDGBL_"^" Q "-1^Invalid Global"
  1. S ICDGBLT=$S(FILE=80:"^ICD9",1:"^ICD0"),ICDGBLID=$S(FILE=80:"^ICDID",1:"^ICDIP")
  1. S ICDC=0,ICDX=0 F S ICDX=$O(@ICDGBLT@(CODE,73,"B",ICDX)) Q:ICDX="" S ARY($P(@ICDGBLID@(ICDX,0),U,1))=1,ICDC=ICDC+1
  1. Q ICDC
  1. ;
  1. CHGIEN(FILE,CODE) ;
  1. N ICDC
  1. I FILE=80 S ICDC=$G(^ICD9(CODE,0)) Q:ICDC="" "" Q $O(^ICD9("B",ICDC,""))
  1. I FILE=80.1 S ICDC=$G(^ICD0(CODE,0)) Q:ICDC="" "" Q $O(^ICD0("B",ICDC,""))
  1. Q ""
  1. ;
  1. ICDIDF(ID,ARY) ; Returns value indicating if identifier(s) exist in an array.
  1. ;
  1. ; Input:
  1. ; ID Diagnosis/Procedure code identifier(s) (required)
  1. ; ARY Array Name passed by reference (required)
  1. ;
  1. ; Output: Returns an 1, 0 or -1
  1. ; 1 if all identifier(s) were found in array
  1. ; 0 if all identifiers were not found
  1. ; -1 error^error message
  1. ;
  1. N ICDI,ICDFND,ICDIDV
  1. I $G(ID)="" Q "-1^Missing identifier"
  1. I $O(ARY(""))="" Q "-1^Missing array elements"
  1. S ICDFND=1
  1. F ICDI=1:1:$L(ID,"^") D Q:'ICDFND
  1. .S ICDIDV=$P(ID,"^",ICDI) Q:ICDIDV=""
  1. .I '$D(ARY(ICDIDV)) S ICDFND=0
  1. Q ICDFND
  1. ;
  1. ICDIDC(FILE,ID,ARY,RESULTS) ; Returns value indicating if identifier(s) exist in a cluster.
  1. ;
  1. ; Input:
  1. ; FILE File to look-up for identifier (required)
  1. ; 82.11 = File #82.11
  1. ; 82.12 = File #82.12
  1. ; ID Diagnosis/Procedure code identifier(s) (required)
  1. ; ARY Array Name passed by reference (required)
  1. ;
  1. ; Output:
  1. ; RESULTS array subscripted by MDC and DRG (ex, RESULTS(MDC,DRG)=""
  1. ; Returns an 1, 0 or -1
  1. ; 1 if all identifier(s) were found in array
  1. ; 0 if all identifiers were not found
  1. ; -1 error^error message
  1. ;
  1. ;
  1. N ICDGBL,ICDIEN,ICDX,ICDDA,ICDI1,ICDI2,ICDI3,ICDI4,ICDJ,ICDDRGDX,ICDCX,ICDFND,ICDARR,ICDMDC,ICDDRG,ICDDRGDX,ICDSUB
  1. I '+$G(FILE) Q "-1^Invalid File"
  1. I $G(ID)="" Q "-1^Missing identifier"
  1. I $O(ARY(""))="" Q "-1^Missing array elements"
  1. S ICDGBL=$P($$ROOT^DILFD(FILE),"(",1)
  1. I "^^ICDIDP(^^ICDIDD(^"'["^"_ICDGBL_"^" Q "-1^Invalid Global"
  1. ;create temp array ARR subscripted by IEN
  1. S ICDX=0 F S ICDX=$O(ARY(ICDX)) Q:'ICDX S ICDCX=ARY(ICDX) I ICDCX'="" S ICDARR(ICDCX)=ICDX
  1. S ICDFND=0
  1. ;get ID from "B" x-ref
  1. ;S IEN=$$GET1^DIQ($S(FILE=82.11:82.1,1:82),ID,.01,"I")
  1. I FILE=82.11 S ICDIEN=$O(^ICDIP("B",ID,""))
  1. I FILE=82.12 S ICDIEN=$O(^ICDID("B",ID,""))
  1. ;S IEN=$$FIND1^DIC(82,"","BX",ID) Q "-1^Invalid identifier"
  1. ;get all the entries for the ID
  1. ;F S X=$O(@(GBL_CODE_",73,""B"",X)"))
  1. ;S DA=0 F S DA=$O(@(GBL_"""B"","_IEN_","_DA_")")) Q:'DA D I FND Q
  1. ;S DA=0 F S DA=$O(@(GBL_"""B"",IEN,DA)")) Q:'DA D I FND Q
  1. S ICDDA=0 F S ICDDA=$O(@ICDGBL@("B",ICDIEN,ICDDA)) Q:'ICDDA D I ICDFND Q
  1. .I '$D(@ICDGBL@(ICDDA,0)) Q
  1. .S ICDI1=0 F S ICDI1=$O(@ICDGBL@(ICDDA,"BL",ICDI1)) Q:'ICDI1 D I ICDFND Q
  1. ..F ICDJ=1:1:5 S ICDI2=0,ICDSUB=$P("ONE/WITH1/WITH2/WITH3/WITH4/","/",ICDJ) F S ICDI2=$O(@ICDGBL@(ICDDA,"BL",ICDI1,ICDSUB,ICDI2)) Q:'ICDI2 D
  1. ...S ICDCX=$G(@ICDGBL@(ICDDA,"BL",ICDI1,ICDSUB,ICDI2,0))
  1. ...S ICDDRGDX(ICDJ,ICDCX)=""
  1. ..;check if DX/PX codes are in cluster
  1. ..S ICDFND=$$BLKCHK()
  1. ..Q:'ICDFND
  1. ..;get MDC and DRG
  1. ..S ICDI3=0 F S ICDI3=$O(@ICDGBL@(ICDDA,"BL",ICDI1,"MDC",ICDI3)) Q:'ICDI3 D
  1. ...S ICDMDC=$G(@ICDGBL@(ICDDA,"BL",ICDI1,"MDC",ICDI3,0))
  1. ...S ICDI4=0 F S ICDI4=$O(@ICDGBL@(ICDDA,"BL",ICDI1,"MDC",ICDI3,"DRG",ICDI4)) Q:'ICDI4 D
  1. ....S ICDDRG=$G(@ICDGBL@(ICDDA,"BL",ICDI1,"MDC",ICDI3,"DRG",ICDI4,0))
  1. ....S RESULTS(ICDMDC,ICDDRG)=""
  1. Q ICDFND
  1. ;
  1. BLKCHK() ;check if DX/PX code is in cluster
  1. N ICDJ,ICDX1,ICDC,ICDFND
  1. S (ICDFND,ICDC)=0
  1. S ICDJ=0 F S ICDJ=$O(ICDDRGDX(ICDJ)) Q:'ICDJ D
  1. .S ICDC=ICDC+1
  1. .S ICDX1=0 F S ICDX1=$O(ICDDRGDX(ICDJ,ICDX1)) Q:'ICDX1 I $D(ICDARR(ICDX1)) S ICDFND=ICDFND+1 Q
  1. S ICDFND=$S('ICDC:0,ICDFND=ICDC:1,1:0)
  1. Q ICDFND
  1. ;
  1. ISOWNCC(IEN,CDT,FMT) ; If DX is Own CC, return the CC value else zero
  1. ;
  1. ; Input:
  1. ;
  1. ; IEN IEN in file 80 (required)
  1. ; CDT Date to use to Extract CC (default TODAY)
  1. ; FMT Output Format
  1. ; 0 = CC only (default)
  1. ; 1 = CC ^ Effective Date
  1. ;
  1. ; Output:
  1. ;
  1. ; $$ISOWNCC Complication/Comorbidity (FMT=0)
  1. ; Complication/Comorbidity^Effective Date (FMT=1)
  1. ;
  1. N ICDCCDAT,ICDCCIEN,ICDCCOUT,ICDCCX,ICDCCOWN
  1. S FMT=+($G(FMT)) S:FMT'=1 FMT=0 S:CDT="" CDT=DT S ICDCCDAT=$O(^ICD9(IEN,69,"B",CDT+.0001),-1) Q:'$L(ICDCCDAT) 0
  1. S ICDCCIEN=$O(^ICD9(IEN,69,"B",ICDCCDAT,""),-1)
  1. S ICDCCX=^ICD9(IEN,69,ICDCCIEN,0),ICDCCOWN=$P(ICDCCX,U,3) I 'ICDCCOWN Q 0
  1. S ICDCCOUT=$P(ICDCCX,U,2) S:FMT>0 ICDCCOUT=ICDCCOUT_"^"_$P(^ICD9(IEN,69,ICDCCIEN,0),U,1)
  1. Q ICDCCOUT
  1. ;
  1. ICDMRG(ARY1,ARY2) ; Merge ARY2 with ARY1 and increment the counter
  1. ;
  1. N ICD10I,ICD10CNT
  1. S ICD10I=""
  1. F ICD10CNT=0:0 S ICD10I=$O(ARY2(ICD10I)) Q:ICD10I="" D
  1. . I $D(ARY1(ICD10I)) S ARY1(ICD10I)=ARY1(ICD10I)+1
  1. . E S ARY1(ICD10I)=1
  1. Q
  1. ;
  1. CLUSTERS ; Load Cluster Identifier Codes into ICD10SD, ICD10OR
  1. N ICDIEN,ICDID,ICDX,ICD10SDT,ICD10ORT,ICDTMP,ICD10PCT,ICDIDC
  1. S ICDID=0 F S ICDID=$O(^ICDIDD(ICDID)) Q:'ICDID S ICDIEN=$G(^ICDIDD(ICDID,0)) I ICDIEN D
  1. . S ICDIDC=$P(^ICDID(ICDIEN,0),U,1)
  1. . S ICDX=$$ICDIDC^ICDRGAPI(82.12,ICDIDC,.ICDDX,.ICDTMP)
  1. . I $P(ICDX,U,1)>0 D
  1. . . S ICD10SD(ICDIDC)=$G(ICD10SD(ICDIDC))+1
  1. . . D LDMDDRGD ; Load DRG and Check MDC for Diagnosis Clusters
  1. I $D(ICDPRC) S ICDID=0 F S ICDID=$O(^ICDIDP(ICDID)) Q:'ICDID S ICDIEN=$G(^ICDIDP(ICDID,0)) I ICDIEN D
  1. . S ICDIDC=$P(^ICDIP(ICDIEN,0),U,1)
  1. . S ICDX=$$ICDIDC^ICDRGAPI(82.11,ICDIDC,.ICDPRC,.ICD10PCT)
  1. . I $P(ICDX,U,1)>0 D
  1. . . S ICD10OR(ICDIDC)=$G(ICD10OR(ICDIDC))+1
  1. . . D LDMDDRGP ; Load DRG and Check MDC for Procedure Clusters
  1. Q
  1. ;
  1. LDMDDRGD ; Load DRG and Check MDC for Diagnosis Clusters
  1. N ICDMDCT,ICDDRGT
  1. S ICDMDCT="" F S ICDMDCT=$O(ICDTMP(ICDMDCT)) Q:'ICDMDCT D
  1. . S ICDDRGT="" F S ICDDRGT=$O(ICDTMP(ICDMDCT,ICDDRGT)) Q:'ICDDRGT D
  1. . . S ICDSDRG(ICDDRGT)=""
  1. Q
  1. ;
  1. LDMDDRGP ; Load DRG and Check MDC for Procedure Clusters
  1. N ICDMDCT,ICDDRGT
  1. S ICDMDCT="" F S ICDMDCT=$O(ICD10PCT(ICDMDCT)) Q:'ICDMDCT D
  1. . I (ICDMDC=ICDMDCT)!(($D(ICDMDC(12))!($D(ICDMDC(13)))>0)&$D(ICDMDC(ICDMDCT))) S ICDONR=ICDONR+1
  1. . S ICDDRGT="" F S ICDDRGT=$O(ICD10PCT(ICDMDCT,ICDDRGT)) Q:'ICDDRGT D
  1. . . S ICDODRG(ICDDRGT)=ICDDRGT
  1. Q
  1. ;
  1. ICDRGCC(DRG,CDT) ;Get CC/MCC flag from DRG (Temporary hard-code of ^ICD pending API)
  1. N ICDCC,ICDIEN,ICDDA,ICDAIEN
  1. S ICDCC=-1,ICDIEN=$O(^ICD("B","DRG"_DRG,"")) I ICDIEN D
  1. . S ICDDA=$O(^ICD(ICDIEN,2,"B",(CDT_".1")),-1) I ICDDA D
  1. . . S ICDAIEN=$O(^ICD(ICDIEN,2,"B",ICDDA,"")) I ICDAIEN D
  1. . . . S ICDCC=$P(^ICD(ICDIEN,2,ICDAIEN,0),U,4)
  1. Q ICDCC
  1. ;
  1. ISACCEX(IEN1,IEN2) ; Is Code 2 an Excluded code of Code 1 so MCC/CC=0
  1. ;
  1. ; Input:
  1. ;
  1. ; IEN1 This is the internal entry number (IEN) of a
  1. ; code in file 80 used as a Secondary diagnosis
  1. ; with IEN2 which is the Principal diagnosis
  1. ;
  1. ; Output:
  1. ;
  1. ; $$ISACCEX Boolean value
  1. ;
  1. ; 1 Yes - IEN2 is an excluded PDX of IEN1 for MCC/CC
  1. ; 0 No - IEN2 is NOT an excluded PDX of IEN1 for MCC/CC
  1. ;
  1. N ICD1,ICD2,ICDPDX,ICDXIEN
  1. S ICD1=$G(IEN1),ICD2=$G(IEN2)
  1. S ICDPDX=$$GET1^DIQ(80,ICD1,1.11,1) I ICDPDX="" Q 0
  1. S ICDXIEN=$O(^ICDCCEX("B",ICDPDX,"")) I ICDXIEN="" Q 0
  1. Q $S($D(^ICDCCEX(ICDXIEN,1,"B",ICD2)):1,1:0)
  1. ;
  1. ICDXEXPT(DXIEN,LIST) ;
  1. ; Checks if the DX code indicated by the DXIEN matches any code in LIST
  1. ;
  1. ; Input:
  1. ; DXIEN is IEN in file 80 Ex: ICDDX(1) in ICDDRG
  1. ; LIST is a list of DX codes in this format ^code^code^code^
  1. ;
  1. ; Output:
  1. ; 1 The DX Code indicated by DXIEN is present in LIST
  1. ; 0 The DX Code indicated by DXIEN is NOT present in LIST
  1. ;
  1. N ICDCODE
  1. S ICDCODE=U_$$GET1^DIQ(80,DXIEN,.01,"E")_U
  1. Q $S(LIST[ICDCODE:1,1:0)
  1. ;