| [613] | 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
|
|---|
