1 | ICDCOD ;ALB/ABR/ADL - INQUIRE TO ICD CODES ; 10/23/00 11:36am
|
---|
2 | ;;18.0;DRG Grouper;**7**;Oct 20, 2000;Build 1
|
---|
3 | ;;ADL;Update for CSV project - 03/20/03
|
---|
4 | ;
|
---|
5 | ;This routine allows entry of an ICD9 or ICD0 code, and returns the description.
|
---|
6 | ;It also alerts the user if it is an inactive code.
|
---|
7 | ;
|
---|
8 | EN ;
|
---|
9 | N DIRUT,DTOUT,DUOUT,DIR,DIC,DA,DR,DIQ,X,Y,ICDTMP
|
---|
10 | DATE D EFFDATE^ICDDRGM G EXIT:$D(DUOUT),EXIT:$D(DTOUT)
|
---|
11 | F S DIR(0)="SO^1:ICD DIAGNOSIS CODE;2:ICD OPERATION/PROCEDURE CODE" D ^DIR Q:Y<0!$D(DIRUT) D @Y Q:$D(DTOUT)
|
---|
12 | G DATE
|
---|
13 | ;
|
---|
14 | 1 ;ICD DIAGNOSIS CODE
|
---|
15 | S DIR(0)="PO^80:QAEM"
|
---|
16 | F W !! D ^DIR Q:Y<0!$D(DIRUT) D
|
---|
17 | .N ICDASK
|
---|
18 | . S DR=".01;3;10;100;102"
|
---|
19 | . S DIC="^ICD9(",DA=+Y,DIQ(0)="EN",DIQ="ICDASK"
|
---|
20 | . D EN^DIQ1
|
---|
21 | . S ICDTMP=$$ICDDX^ICDCODE(+DA,ICDDATE)
|
---|
22 | . W !!,ICDASK(80,DA,.01,"E"),?15,ICDASK(80,DA,3,"E"),!,$G(ICDASK(80,DA,10,"E"))," ",$P(ICDTMP,U,18),! ;add printing of descript disclaimer msg
|
---|
23 | . 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," **",!
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | 2 ;ICD OPERATION/PROCEDURE
|
---|
27 | S DIR(0)="PO^80.1:QAEM"
|
---|
28 | F W !! D ^DIR Q:Y<0!$D(DIRUT) D
|
---|
29 | . N ICDASK
|
---|
30 | . S DIC="^ICD0(",DA=+Y,DR=".01;4;10;100;102",DIQ(0)="EN",DIQ="ICDASK"
|
---|
31 | . D EN^DIQ1
|
---|
32 | . S ICDTMP=$$ICDOP^ICDCODE(+DA,ICDDATE)
|
---|
33 | . W !!,ICDASK(80.1,DA,.01,"E"),?15,ICDASK(80.1,DA,4,"E"),!,$G(ICDASK(80.1,DA,10,"E"))," ",$P(ICDTMP,U,14),! ;add printing of descript disclaimer msg
|
---|
34 | . 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," **",!
|
---|
35 | Q
|
---|
36 | EXIT Q ;Exit subroutine
|
---|