ICDCOD ;ALB/ABR/ADL/KUM - INQUIRE TO ICD CODES ;10/23/00 11:36am
;;18.0;DRG Grouper;**7,57,64**;Oct 20, 2000;Build 103
;;ADL;Update for CSV project - 03/20/03
;;KUM;Added new items to search ICD-10 diagnosis and ICD-10 procedure code
;
;This routine allows entry of an ICD9 or ICD10 code, and returns the description.
;It also alerts the user if it is an inactive code.
;
; $$ICDDX^ICDEX covered by ICR#5747
; $$ICDOP^ICDEX covered by ICR#5747
;
EN ;
N DIRUT,DTOUT,DUOUT,DIR,DIC,DR,DIQ,X,Y,ICDTMP,ICDSYS
DATE D EFFDATE^ICDDRGM G EXIT:$D(DUOUT),EXIT:$D(DTOUT)
F S DIR(0)="SO^1:ICD 9 DIAGNOSIS CODE;2:ICD 9 OPERATION/PROCEDURE CODE;3:ICD 10 DIAGNOSIS CODE;4:ICD 10 OPERATION/PROCEDURE CODE" D ^DIR Q:Y<0!$D(DIRUT) D @Y Q:$D(DTOUT)
G DATE
;
1 ;ICD-9 DIAGNOSIS CODE
S ICDSYS="ICD9"
S IENT="I"
F W !! S DIC("A")="Select ICD-9 Diagnosis: ",Y=$$SEARCH^ICDSAPI(80,"I $P($$ICDDX^ICDEX(+$G(Y),$G(ICDDATE),1,IENT),U,1)>0","AEMQZI",$G(ICDDATE)) Q:Y<=0 D
. S ICDTMP=$$ICDDX^ICDEX(+$G(Y),$G(ICDDATE),1,IENT)
. W !!,$P(ICDTMP,U,2),?15,$P(ICDTMP,U,4),!,$P(ICDTMP,U,11)," ",$P(ICDTMP,U,18),! ;add printing of descript disclaimer msg
. I '$P(ICDTMP,U,10) W " **CODE INACTIVE" I $P(ICDTMP,U,12)'="" S Y=$P(ICDTMP,U,12) D DD^%DT W " AS OF ",Y," **",!
Q
;
2 ;ICD-9 OPERATION/PROCEDURE
S IENT="I"
F W !! S DIC("A")="Select ICD-9 Procedure: ",Y=$$SEARCH^ICDSAPI(80.1,"I $P($$ICDOP^ICDEX(+$G(Y),$G(ICDDATE),2,IENT),U,1)>0","AEMQZI",$G(ICDDATE)) Q:Y<=0 D
. S ICDTMP=$$ICDOP^ICDEX(+$G(Y),$G(ICDDATE),2,IENT)
. W !!,$P(ICDTMP,U,2),?15,$P(ICDTMP,U,5),!,$P(ICDTMP,U,11)," ",$P(ICDTMP,U,14),! ;add printing of descript disclaimer msg
. I '$P(ICDTMP,U,10) W " **CODE INACTIVE" I $P(ICDTMP,U,12)'="" S Y=$P(ICDTMP,U,12) D DD^%DT W " AS OF ",Y," **",!
Q
3 ;ICD-10 DIAGNOSIS CODE
D ^ICDDSLK
Q
;
4 ;ICD-10 OPERATION/PROCEDURE
D ^ICDCODLK
Q
EXIT Q ;Exit subroutine
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDCOD 1929 printed Oct 16, 2024@17:50:42 Page 2
ICDCOD ;ALB/ABR/ADL/KUM - INQUIRE TO ICD CODES ;10/23/00 11:36am
+1 ;;18.0;DRG Grouper;**7,57,64**;Oct 20, 2000;Build 103
+2 ;;ADL;Update for CSV project - 03/20/03
+3 ;;KUM;Added new items to search ICD-10 diagnosis and ICD-10 procedure code
+4 ;
+5 ;This routine allows entry of an ICD9 or ICD10 code, and returns the description.
+6 ;It also alerts the user if it is an inactive code.
+7 ;
+8 ; $$ICDDX^ICDEX covered by ICR#5747
+9 ; $$ICDOP^ICDEX covered by ICR#5747
+10 ;
EN ;
+1 NEW DIRUT,DTOUT,DUOUT,DIR,DIC,DR,DIQ,X,Y,ICDTMP,ICDSYS
DATE DO EFFDATE^ICDDRGM
if $DATA(DUOUT)
GOTO EXIT
if $DATA(DTOUT)
GOTO EXIT
+1 FOR
SET DIR(0)="SO^1:ICD 9 DIAGNOSIS CODE;2:ICD 9 OPERATION/PROCEDURE CODE;3:ICD 10 DIAGNOSIS CODE;4:ICD 10 OPERATION/PROCEDURE CODE"
DO ^DIR
if Y<0!$DATA(DIRUT)
QUIT
DO @Y
if $DATA(DTOUT)
QUIT
+2 GOTO DATE
+3 ;
1 ;ICD-9 DIAGNOSIS CODE
+1 SET ICDSYS="ICD9"
+2 SET IENT="I"
+3 FOR
WRITE !!
SET DIC("A")="Select ICD-9 Diagnosis: "
SET Y=$$SEARCH^ICDSAPI(80,"I $P($$ICDDX^ICDEX(+$G(Y),$G(ICDDATE),1,IENT),U,1)>0","AEMQZI",$GET(ICDDATE))
if Y<=0
QUIT
Begin DoDot:1
+4 SET ICDTMP=$$ICDDX^ICDEX(+$GET(Y),$GET(ICDDATE),1,IENT)
+5 ;add printing of descript disclaimer msg
WRITE !!,$PIECE(ICDTMP,U,2),?15,$PIECE(ICDTMP,U,4),!,$PIECE(ICDTMP,U,11)," ",$PIECE(ICDTMP,U,18),!
+6 IF '$PIECE(ICDTMP,U,10)
WRITE " **CODE INACTIVE"
IF $PIECE(ICDTMP,U,12)'=""
SET Y=$PIECE(ICDTMP,U,12)
DO DD^%DT
WRITE " AS OF ",Y," **",!
End DoDot:1
+7 QUIT
+8 ;
2 ;ICD-9 OPERATION/PROCEDURE
+1 SET IENT="I"
+2 FOR
WRITE !!
SET DIC("A")="Select ICD-9 Procedure: "
SET Y=$$SEARCH^ICDSAPI(80.1,"I $P($$ICDOP^ICDEX(+$G(Y),$G(ICDDATE),2,IENT),U,1)>0","AEMQZI",$GET(ICDDATE))
if Y<=0
QUIT
Begin DoDot:1
+3 SET ICDTMP=$$ICDOP^ICDEX(+$GET(Y),$GET(ICDDATE),2,IENT)
+4 ;add printing of descript disclaimer msg
WRITE !!,$PIECE(ICDTMP,U,2),?15,$PIECE(ICDTMP,U,5),!,$PIECE(ICDTMP,U,11)," ",$PIECE(ICDTMP,U,14),!
+5 IF '$PIECE(ICDTMP,U,10)
WRITE " **CODE INACTIVE"
IF $PIECE(ICDTMP,U,12)'=""
SET Y=$PIECE(ICDTMP,U,12)
DO DD^%DT
WRITE " AS OF ",Y," **",!
End DoDot:1
+6 QUIT
3 ;ICD-10 DIAGNOSIS CODE
+1 DO ^ICDDSLK
+2 QUIT
+3 ;
4 ;ICD-10 OPERATION/PROCEDURE
+1 DO ^ICDCODLK
+2 QUIT
EXIT ;Exit subroutine
QUIT
