| [613] | 1 | LRSPSICD ;AVAMC/REG - CY/EM/SP ICD SEARCH ;8/15/95 08:39
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,253**;Sep 27, 1994
|
|---|
| 3 | W @IOF,!?20,LRO(68)," SEARCH BY ICD9CM CODE"
|
|---|
| 4 | ASK S DIC=80,DIC(0)="AEMOQZ" D ^DIC K DIC Q:Y<1 S N=+Y,I(1)=$P(Y(0),U,1),I=$P(Y(0),U,3)
|
|---|
| 5 | W ! D B^LRU Q:Y<0 S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
|
|---|
| 6 | S ZTRTN="QUE^LRSPSICD" D BEG^LRUTL Q:POP!($D(ZTSK))
|
|---|
| 7 | QUE U IO K ^TMP($J) D L^LRU,S^LRU,XR^LRU
|
|---|
| 8 | S ^TMP($J,0)=I(1)_"^"_I_"^"_LRO(68)_"^"_"ICD9CM CODE"
|
|---|
| 9 | F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D L
|
|---|
| 10 | D ^LRSPSICP K ^TMP($J) D K^LRU,END^LRUTL Q
|
|---|
| 11 | L F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D I
|
|---|
| 12 | Q
|
|---|
| 13 | I F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI D TO
|
|---|
| 14 | Q
|
|---|
| 15 | TO Q:$P($P($G(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")'=LRABV Q:'$D(^(3,N,0))
|
|---|
| 16 | S LREP=^LR(LRDFN,LRSS,LRI,0),H(2)=$E($P(LREP,"^",10),1,3)
|
|---|
| 17 | S LRAC=$P(LREP,"^",6),LRAN=+$P(LRAC," ",3)
|
|---|
| 18 | PRT S LRPF=^DIC($P(^LR(LRDFN,0),"^",2),0,"GL"),LRFLN=+$P(@(LRPF_"0)"),"^",2),DFN=$P(^LR(LRDFN,0),"^",3),LRDPF=$P(^(0),U,2) Q:'$D(@(LRPF_DFN_",0)"))
|
|---|
| 19 | S LRPPT=@(LRPF_DFN_",0)"),LRP=$P(LRPPT,"^"),SSN=$P(LRPPT,"^",9),SEX=$P(LRPPT,"^",2),DOB=$P(LRPPT,"^",3),X1=$P(LREP,"^"),X2=DOB D ^%DTC,SSN^LRU S AGE=X\365.25
|
|---|
| 20 | S:AGE>110!(AGE<10) AGE="?"
|
|---|
| 21 | S ^TMP($J,H(2),LRAN)=LRAC_U_AGE_U_SEX_U_LRP_U_SSN(1)_U_+$E($P(LREP,U,10),4,5)_"/"_$E($P(LREP,U,10),6,7),^TMP($J,"B",LRP,H(2),LRAN)=""
|
|---|
| 22 | HERE Q
|
|---|
