| [613] | 1 | LRAUSICD ;AVAMC/REG - AUTOPSY ICD9CM SEARCH ;8/15/95 09:01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,253**;Sep 27, 1994
|
|---|
| 3 | S IOP="HOME" D ^%ZIS W @IOF,?20,LRO(68)," SEARCH BY ICD9CM CODE"
|
|---|
| 4 | ASK S DIC=80,DIC(0)="AEQMZ" D ^DIC K DIC Q:Y<1 S N=+Y,I(1)=$P(Y(0),U,1),I=$P(Y(0),U,3)
|
|---|
| 5 | D B^LRU Q:Y<0 S LRLDT=LRLDT+.99
|
|---|
| 6 | S ZTRTN="QUE^LRAUSICD" D BEG^LRUTL Q:POP!($D(ZTSK))
|
|---|
| 7 | QUE U IO D S^LRU K ^TMP($J) S LRPAT1=0,^TMP($J,0,1)="ICD9CM CODE: "_I(1)_" "_I,^TMP($J,0)=I(1)_"^"_I_"^"_LRO(68)_"^"_"ICD CODE"
|
|---|
| 8 | F X=0:0 S LRSDT=$O(^LR("AAU",LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D LRDFN
|
|---|
| 9 | D ^LRAUS K ^TMP($J) D END^LRUTL Q
|
|---|
| 10 | LRDFN S LRDFN=0 F LRPAT1=0:1 S LRDFN=$O(^LR("AAU",LRSDT,LRDFN)) Q:'LRDFN D SN
|
|---|
| 11 | Q
|
|---|
| 12 | SN Q:$P($P($G(^LR(LRDFN,"AU")),U,6)," ")'=LRABV Q:'$D(^LR(LRDFN,80,N,0))!('$D(^LR(LRDFN,0))#2) S LRAU=^("AU"),LRAD=$P(LRAU,"^")
|
|---|
| 13 | S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRPF=^DIC(LRDPF,0,"GL"),LRFLN=+$P(@(LRPF_"0)"),"^",2) Q:'$D(@(LRPF_DFN_",0)"))
|
|---|
| 14 | S LRPPT=@(LRPF_DFN_",0)"),LRP=$P(LRPPT,"^"),SSN=$P(LRPPT,"^",9),SEX=$P(LRPPT,"^",2),DOB=$P(LRPPT,"^",3) D SSN^LRU
|
|---|
| 15 | S LRYR=$E($P(LRAU,"^"),1,3),LRAC=$P(LRAU,"^",6),LRAN=+$P(LRAC," ",3)
|
|---|
| 16 | S X1=$P(LRAU,"^"),X2=DOB D ^%DTC S AGE=X\365.25
|
|---|
| 17 | S:AGE<1 AGE="<1"
|
|---|
| 18 | S ^TMP($J,LRYR,LRAN)=LRAC_"^"_AGE_"^"_SEX_"^"_LRP_"^"_SSN(1)_"^"_+$E($P(LRAU,"^"),4,5)_"/"_+$E($P(LRAU,"^"),6,7)
|
|---|
| 19 | Q
|
|---|
