source: WorldVistAEHR/trunk/r/DRG_GROUPER-ICD--ICPT/ICDCOD.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1ICDCOD ;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 ;
8EN ;
9 N DIRUT,DTOUT,DUOUT,DIR,DIC,DA,DR,DIQ,X,Y,ICDTMP
10DATE 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 ;
141 ;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 ;
262 ;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
36EXIT Q ;Exit subroutine
Note: See TracBrowser for help on using the repository browser.