| 1 | LRBLJPP1 ;AVAMC/REG - PT ADM,RX SPECIALTY,ICD9CM CODES ;4/17/91 14:31 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | K LRF,LRC S LRA=$O(^DGPM("APID",DFN,0)) Q:'LRA S LRX=$O(^(LRA,0)) D:$Y>(IOSL-9) H Q:LR("Q") I LRX,$D(^DGPM(LRX,0)) S X=^(0) I $P(X,"^",14),$D(^DGPM($P(X,"^",14),0)) S LRX=$P(X,"^",14) D A ;MAS
|
|---|
| 5 | F LRA=LRA:0 S LRA=$O(^DGPM("APID",DFN,LRA)) Q:'LRA!(LRA>LRSDT)!(LR("Q")) S LRX=$O(^(LRA,0)) D:$Y>(IOSL-9) H Q:LR("Q") D:LRX A ;MAS
|
|---|
| 6 | Q
|
|---|
| 7 | A S Y=$S($D(^DGPM(LRX,0)):^(0),1:""),LR=$P(Y,"^",16) W !,"Adm:",+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_$E(Y,2,3) S Z=$P(Y,"^",17) I Z S Z=$S($D(^DGPM(Z,0)):+^(0),1:"") W ?13,"Discharge:",+$E(Z,4,5)_"/"_+$E(X,6,7)_"/"_$E(Z,2,3) ;MAS
|
|---|
| 8 | S Z=$P(Y,"^",6) I Z,$D(^DIC(42,Z,0)) W ?35,$P(^(0),"^") ;MAS
|
|---|
| 9 | S A=0 F B=0:0 S A=$O(^DGPM("ATS",LRX,A)) Q:'A!(LR("Q")) S C=$O(^(A,0)) D B Q:LR("Q") ;MAS
|
|---|
| 10 | Q:'LR
|
|---|
| 11 | I $D(^DGPT(LR,70)),$P(^(70),"^",10) S W=^(70) F X=10,11,16:1:24 I $P(W,"^",X) S LRF($P(W,"^",X))=""
|
|---|
| 12 | F Y=0:0 S Y=$O(^DGPT(LR,"M",Y)) Q:'Y S W=^(Y,0) F X=5:1:9,11:1:15 I $P(W,"^",X) S LRF($P(W,"^",X))=""
|
|---|
| 13 | I $D(^DGPT(LR,"401P")) S W=^("401P") F X=1:1:5 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 14 | F Y=0:0 S Y=$O(^DGPT(LR,"P",Y)) Q:'Y S W=^(Y,0) F X=5:1:9 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 15 | F Y=0:0 S Y=$O(^DGPT(LR,"S",Y)) Q:'Y S W=^(Y,0) F X=8:1:12 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 16 | F C=0:0 S C=$O(LRF(C)) Q:'C!(LR("Q")) I $D(^ICD9(C)) S W=^(C,0) D:$Y>(IOSL-9) H Q:LR("Q") W !,$P(W,"^"),?10,$P(W,"^",3)
|
|---|
| 17 | F C=0:0 S C=$O(LRC(C)) Q:'C!(LR("Q")) I $D(^ICD0(C)) S W=^(C,0) D:$Y>(IOSL-9) H Q:LR("Q") W !,$P(W,"^"),?10,$P(W,"^",4)
|
|---|
| 18 | Q
|
|---|
| 19 | B I C,$D(^DGPM(C,0)) S LRY=^(0) D:$Y>(IOSL-9) H Q:LR("Q") S Z=$P(LRY,"^",9) W !?12,"Specialty:",+$E(LRY,4,5)_"/"_+$E(LRY,6,7)_"/"_$E(LRY,2,3) I Z,$D(^DIC(45.7,Z,0)) W ?35,$P(^(0),"^") ;MAS
|
|---|
| 20 | Q
|
|---|
| 21 | H D H1^LRBLJPP Q
|
|---|
