| [613] | 1 | XTLKTICD ; IHS/OHPRD/ACC,ALB/JLU,SFISC/JC- DRIVER ROUTINE FOR ICD LOOKUP UTILITY ;04/06/95 14:19
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | KL K XTLKX,XTLKY,XTLKPF,XTLKUT,DIC,XTLKWD2 Q
|
|---|
| 5 | ;
|
|---|
| 6 | A D QU^XTLKEFOP()
|
|---|
| 7 | I '$D(XTLKY) D KL Q
|
|---|
| 8 | W !,"NARRATIVE: " R XTLKX:DTIME I $D(XTLKX) D LKUP^XTLKMGR(+XTLKY,XTLKX)
|
|---|
| 9 | D KL
|
|---|
| 10 | Q
|
|---|
| 11 | ;K XTLKUT S DIC("A")="NARRATIVE: ",DIC=+XTLKY,DIC(0)="AEMQ" D ^DIC,KL Q
|
|---|
| 12 | ;
|
|---|
| 13 | COMMON W ! F Q=0:0 R "NARRATIVE: ",X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" Q:"^"[X W:X?.E1C.E $C(7)," -- NO CONTROL CHARACTERS ALLOWED!",! D:X'?.E1C.E LOOKUP
|
|---|
| 14 | W !
|
|---|
| 15 | K XTLKTTYP,Q
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | ;;;Everything from LOOKUP and under is from old logic. Kept in only
|
|---|
| 19 | ;;;because it might be needed or wanted again.
|
|---|
| 20 | LOOKUP ;
|
|---|
| 21 | ;;;I X="^SYN" S DIE="^XTLKKWLC(",DR=".011:999",DA=$O(^XTLKKWLC("B",XTLKTTYP,"")) D ^DIE W ! Q
|
|---|
| 22 | K DIC I +XTLKTTYP=80!(+XTLKTTYP=80.1) S DIC("S")="I $P(^(0),""^"",9)=""""" ; SCREEN OUT INACTIVE CODES
|
|---|
| 23 | S:+XTLKTTYP=80 DIC("S")=DIC("S")_",'(+^(0)>300&+^(0)<400&($L($P($P(^(0),""^"",1),""."",2))=3))"
|
|---|
| 24 | S:+XTLKTTYP=80.1 DIC("S")=DIC("S")_",'($L($P($P(^(0),""^"",1),""."",2))=3)"
|
|---|
| 25 | I X'?1N.E,X'?1"E"1N.E,X'?1"V"1N.E,X'?1"."1N.N G NARR
|
|---|
| 26 | CODE ;;;S DIC=$S($E(XTLKTTYP)="D":80,1:80.1),DIC(0)="EQMZ" D ^DIC W ! Q
|
|---|
| 27 | NARR ;;;W ! G ICDDX^XTLKKWLD:$E(XTLKTTYP)="D",ICDOP^XTLKKWLD
|
|---|
