ICDEXD3 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
;
;
; Global Variables
; ^ICDCCEX( N/A
; ^TMP(SUB,$J SACC 2.3.2.5.1
;
; External References
; None
;
Q
NOT(IEN,SUB,FMT) ; Codes not Used With
;
; Input:
;
; IEN Internal Entry Number in file 80
; SUB TMP global array subscript name.
; If not provided, the subscript
; "ICDNOT" will be used.
; FMT Format of Output
; 0 - Total number only (default)
; 1 - Total number with global array
;
; Output:
;
; $$NOT The number of ICD codes that can not
; be used with the ICD code identified
; by IEN (FMT=0 or 1)
;
; TMP global array as follows (FMT=1):
;
; ^TMP("SUB",$J,IEN)=CODE
; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
;
S IEN=+($G(IEN)) Q:$O(^ICD9(IEN,"N",0))'>0 0
S SUB=$$TM($G(SUB)) S:'$L(SUB) SUB="ICDNOT" S FMT=+($G(FMT)) K ^TMP(SUB,$J)
N NIEN,NCNT S (NIEN,NCNT)=0 F S NIEN=$O(^ICD9(IEN,"N",NIEN)) Q:+NIEN'>0 D
. N CODE,NOT,TIEN S TIEN=$G(^ICD9(IEN,"N",NIEN,0)) Q:TIEN'>0
. S CODE=$P($G(^ICD9(TIEN,0)),"^",1) Q:'$L(CODE) Q:$D(^TMP(SUB,$J,"B",(CODE_" ")))
. S ^TMP(SUB,$J,TIEN)=CODE,^TMP(SUB,$J,"B",(CODE_" "),TIEN)="",NCNT=NCNT+1
K:FMT'>0 ^TMP(SUB,$J)
Q NCNT
REQ(IEN,SUB,FMT) ; Codes Required With
;
; Input:
;
; IEN Internal Entry Number in file 80
; SUB TMP global array subscript name.
; If not provided, the subscript
; "ICDREQ" will be used.
; FMT Format of Output
; 0 - Total number only (default)
; 1 - Total number with global array
;
; Output:
;
; $$REQ The number of ICD codes requires when
; the ICD code identified by IEN is used.
; (FMT=0 or 1)
;
; TMP global array as follows (FMT=1):
;
; ^TMP("SUB",$J,IEN)=CODE
; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
;
S IEN=+($G(IEN)) Q:$O(^ICD9(IEN,"R",0))'>0 0
S SUB=$$TM($G(SUB)) S:'$L(SUB) SUB="ICDREQ" S FMT=+($G(FMT)) K ^TMP(SUB,$J)
N NIEN,NCNT S (NIEN,NCNT)=0 F S NIEN=$O(^ICD9(IEN,"R",NIEN)) Q:+NIEN'>0 D
. N CODE,REQ,TIEN S TIEN=$G(^ICD9(IEN,"R",NIEN,0)) Q:TIEN'>0
. S CODE=$P($G(^ICD9(TIEN,0)),"^",1) Q:'$L(CODE) Q:$D(^TMP(SUB,$J,"B",(CODE_" ")))
. S ^TMP(SUB,$J,TIEN)=CODE,^TMP(SUB,$J,"B",(CODE_" "),TIEN)="",NCNT=NCNT+1
K:FMT'>0 ^TMP(SUB,$J)
Q NCNT
Q
NCC(IEN,SUB,FMT) ; Codes not considered CC With
;
; Input:
;
; IEN Internal Entry Number in file 80
; SUB TMP global array subscript name.
; If not provided, the subscript
; "ICDNCC" will be used.
; FMT Format of Output
; 0 - Total number only (default)
; 1 - Total number with global array
;
; Output:
;
; $$NCC The number of ICD codes not considered
; as Complication/Comorbidity with the
; ICD code identified by IEN.
; (FMT=0 or 1)
;
; TMP global array as follows (FMT=1):
;
; ^TMP("SUB",$J,IEN)=CODE
; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
;
S IEN=+($G(IEN)) Q:$O(^ICD9(IEN))'>0 0
S SUB=$$TM($G(SUB)) S:'$L(SUB) SUB="ICDNCC" S FMT=+($G(FMT)) K ^TMP(SUB,$J)
N NIEN,NCNT,PDXE,ICDCS S NCNT=0,ICDCS=$P($G(^ICD9(IEN,1)),"^",1)
S PDXE=$$PDXE^ICDEX(IEN) I PDXE>0 D K:FMT'>0 ^TMP(SUB,$J) Q NCNT
. S (NIEN,NCNT)=0 F S NIEN=$O(^ICDCCEX(+PDXE,1,NIEN)) Q:+NIEN'>0 D
. . N CODE,NCC S NCC=$P($G(^ICDCCEX(+PDXE,1,+NIEN,0)),"^",1) Q:+NCC'>0
. . S CODE=$P($G(^ICD9(NCC,0)),"^",1) Q:'$L(CODE) Q:$D(^TMP(SUB,$J,"B",(CODE_" ")))
. . S NCNT=NCNT+1,^TMP(SUB,$J,NCNT)=CODE,^TMP(SUB,$J,"B",(CODE_" "),NCNT)=""
. . S ^TMP(SUB,$J,0)=NCNT
I ICDCS=1!(ICDCS=2) S (NIEN,NCNT)=0 F S NIEN=$O(^ICD9(IEN,2,NIEN)) Q:+NIEN'>0 D
. N CODE,NCC S NCC=$P($G(^ICD9(IEN,2,NIEN,0)),"^",1) Q:+NCC'>0
. S CODE=$P($G(^ICD9(NCC,0)),"^",1) Q:'$L(CODE)
. Q:$D(^TMP(SUB,$J,"B",(CODE_" ")))
. S NCNT=NCNT+1,^TMP(SUB,$J,NCNT)=CODE,^TMP(SUB,$J,"B",(CODE_" "),NCNT)=""
. S ^TMP(SUB,$J,0)=NCNT
K:FMT'>0 ^TMP(SUB,$J)
Q NCNT
Q
PDXE(IEN) ; Primary DX Exclusion Code
;
; Input
;
; IEN Internal Entry Number (IEN) for file #80
;
; Output
;
; $$PDXE Pointer to DRG CC Exclusions file #82.13
; or <null> if not found
Q $P($G(^ICD9(+($G(IEN)),1)),"^",11)
TM(X,Y) ; Trim Character
;
; Input:
;
; X Input String
; Y Character to Trim (default " ")
;
; Output:
;
; X String without Leading/Trailing character Y
;
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" "
F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
Q X
ICDEXD3 ;SLC/KER - ICD Extractor - DRG APIs (cont) ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
+2 ;
+3 ;
+4 ; Global Variables
+5 ; ^ICDCCEX( N/A
+6 ; ^TMP(SUB,$J SACC 2.3.2.5.1
+7 ;
+8 ; External References
+9 ; None
+10 ;
+11 QUIT
NOT(IEN,SUB,FMT) ; Codes not Used With
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number in file 80
+5 ; SUB TMP global array subscript name.
+6 ; If not provided, the subscript
+7 ; "ICDNOT" will be used.
+8 ; FMT Format of Output
+9 ; 0 - Total number only (default)
+10 ; 1 - Total number with global array
+11 ;
+12 ; Output:
+13 ;
+14 ; $$NOT The number of ICD codes that can not
+15 ; be used with the ICD code identified
+16 ; by IEN (FMT=0 or 1)
+17 ;
+18 ; TMP global array as follows (FMT=1):
+19 ;
+20 ; ^TMP("SUB",$J,IEN)=CODE
+21 ; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
+22 ;
+23 SET IEN=+($GET(IEN))
IF $ORDER(^ICD9(IEN,"N",0))'>0
QUIT 0
+24 SET SUB=$$TM($GET(SUB))
IF '$LENGTH(SUB)
SET SUB="ICDNOT"
SET FMT=+($GET(FMT))
KILL ^TMP(SUB,$JOB)
+25 NEW NIEN,NCNT
SET (NIEN,NCNT)=0
FOR
SET NIEN=$ORDER(^ICD9(IEN,"N",NIEN))
IF +NIEN'>0
QUIT
Begin DoDot:1
+26 NEW CODE,NOT,TIEN
SET TIEN=$GET(^ICD9(IEN,"N",NIEN,0))
IF TIEN'>0
QUIT
+27 SET CODE=$PIECE($GET(^ICD9(TIEN,0)),"^",1)
IF '$LENGTH(CODE)
QUIT
IF $DATA(^TMP(SUB,$JOB,"B",(CODE_" ")))
QUIT
+28 SET ^TMP(SUB,$JOB,TIEN)=CODE
SET ^TMP(SUB,$JOB,"B",(CODE_" "),TIEN)=""
SET NCNT=NCNT+1
End DoDot:1
+29 IF FMT'>0
KILL ^TMP(SUB,$JOB)
+30 QUIT NCNT
REQ(IEN,SUB,FMT) ; Codes Required With
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number in file 80
+5 ; SUB TMP global array subscript name.
+6 ; If not provided, the subscript
+7 ; "ICDREQ" will be used.
+8 ; FMT Format of Output
+9 ; 0 - Total number only (default)
+10 ; 1 - Total number with global array
+11 ;
+12 ; Output:
+13 ;
+14 ; $$REQ The number of ICD codes requires when
+15 ; the ICD code identified by IEN is used.
+16 ; (FMT=0 or 1)
+17 ;
+18 ; TMP global array as follows (FMT=1):
+19 ;
+20 ; ^TMP("SUB",$J,IEN)=CODE
+21 ; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
+22 ;
+23 SET IEN=+($GET(IEN))
IF $ORDER(^ICD9(IEN,"R",0))'>0
QUIT 0
+24 SET SUB=$$TM($GET(SUB))
IF '$LENGTH(SUB)
SET SUB="ICDREQ"
SET FMT=+($GET(FMT))
KILL ^TMP(SUB,$JOB)
+25 NEW NIEN,NCNT
SET (NIEN,NCNT)=0
FOR
SET NIEN=$ORDER(^ICD9(IEN,"R",NIEN))
IF +NIEN'>0
QUIT
Begin DoDot:1
+26 NEW CODE,REQ,TIEN
SET TIEN=$GET(^ICD9(IEN,"R",NIEN,0))
IF TIEN'>0
QUIT
+27 SET CODE=$PIECE($GET(^ICD9(TIEN,0)),"^",1)
IF '$LENGTH(CODE)
QUIT
IF $DATA(^TMP(SUB,$JOB,"B",(CODE_" ")))
QUIT
+28 SET ^TMP(SUB,$JOB,TIEN)=CODE
SET ^TMP(SUB,$JOB,"B",(CODE_" "),TIEN)=""
SET NCNT=NCNT+1
End DoDot:1
+29 IF FMT'>0
KILL ^TMP(SUB,$JOB)
+30 QUIT NCNT
+31 QUIT
NCC(IEN,SUB,FMT) ; Codes not considered CC With
+1 ;
+2 ; Input:
+3 ;
+4 ; IEN Internal Entry Number in file 80
+5 ; SUB TMP global array subscript name.
+6 ; If not provided, the subscript
+7 ; "ICDNCC" will be used.
+8 ; FMT Format of Output
+9 ; 0 - Total number only (default)
+10 ; 1 - Total number with global array
+11 ;
+12 ; Output:
+13 ;
+14 ; $$NCC The number of ICD codes not considered
+15 ; as Complication/Comorbidity with the
+16 ; ICD code identified by IEN.
+17 ; (FMT=0 or 1)
+18 ;
+19 ; TMP global array as follows (FMT=1):
+20 ;
+21 ; ^TMP("SUB",$J,IEN)=CODE
+22 ; ^TMP("SUB",$J,"B",(CODE_" "),IEN)=""
+23 ;
+24 SET IEN=+($GET(IEN))
IF $ORDER(^ICD9(IEN))'>0
QUIT 0
+25 SET SUB=$$TM($GET(SUB))
IF '$LENGTH(SUB)
SET SUB="ICDNCC"
SET FMT=+($GET(FMT))
KILL ^TMP(SUB,$JOB)
+26 NEW NIEN,NCNT,PDXE,ICDCS
SET NCNT=0
SET ICDCS=$PIECE($GET(^ICD9(IEN,1)),"^",1)
+27 SET PDXE=$$PDXE^ICDEX(IEN)
IF PDXE>0
Begin DoDot:1
+28 SET (NIEN,NCNT)=0
FOR
SET NIEN=$ORDER(^ICDCCEX(+PDXE,1,NIEN))
IF +NIEN'>0
QUIT
Begin DoDot:2
+29 NEW CODE,NCC
SET NCC=$PIECE($GET(^ICDCCEX(+PDXE,1,+NIEN,0)),"^",1)
IF +NCC'>0
QUIT
+30 SET CODE=$PIECE($GET(^ICD9(NCC,0)),"^",1)
IF '$LENGTH(CODE)
QUIT
IF $DATA(^TMP(SUB,$JOB,"B",(CODE_" ")))
QUIT
+31 SET NCNT=NCNT+1
SET ^TMP(SUB,$JOB,NCNT)=CODE
SET ^TMP(SUB,$JOB,"B",(CODE_" "),NCNT)=""
+32 SET ^TMP(SUB,$JOB,0)=NCNT
End DoDot:2
End DoDot:1
IF FMT'>0
KILL ^TMP(SUB,$JOB)
QUIT NCNT
+33 IF ICDCS=1!(ICDCS=2)
SET (NIEN,NCNT)=0
FOR
SET NIEN=$ORDER(^ICD9(IEN,2,NIEN))
IF +NIEN'>0
QUIT
Begin DoDot:1
+34 NEW CODE,NCC
SET NCC=$PIECE($GET(^ICD9(IEN,2,NIEN,0)),"^",1)
IF +NCC'>0
QUIT
+35 SET CODE=$PIECE($GET(^ICD9(NCC,0)),"^",1)
IF '$LENGTH(CODE)
QUIT
+36 IF $DATA(^TMP(SUB,$JOB,"B",(CODE_" ")))
QUIT
+37 SET NCNT=NCNT+1
SET ^TMP(SUB,$JOB,NCNT)=CODE
SET ^TMP(SUB,$JOB,"B",(CODE_" "),NCNT)=""
+38 SET ^TMP(SUB,$JOB,0)=NCNT
End DoDot:1
+39 IF FMT'>0
KILL ^TMP(SUB,$JOB)
+40 QUIT NCNT
+41 QUIT
PDXE(IEN) ; Primary DX Exclusion Code
+1 ;
+2 ; Input
+3 ;
+4 ; IEN Internal Entry Number (IEN) for file #80
+5 ;
+6 ; Output
+7 ;
+8 ; $$PDXE Pointer to DRG CC Exclusions file #82.13
+9 ; or <null> if not found
+10 QUIT $PIECE($GET(^ICD9(+($GET(IEN)),1)),"^",11)
TM(X,Y) ; Trim Character
+1 ;
+2 ; Input:
+3 ;
+4 ; X Input String
+5 ; Y Character to Trim (default " ")
+6 ;
+7 ; Output:
+8 ;
+9 ; X String without Leading/Trailing character Y
+10 ;
+11 SET X=$GET(X)
IF X=""
QUIT X
SET Y=$GET(Y)
IF '$LENGTH(Y)
SET Y=" "
+12 FOR
IF $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+13 FOR
IF $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+14 QUIT X
