| 1 | LRAPQAT1 ;AVAMC/REG/CYM- QA CODE SEARCH ;2/12/98 14:31
|
|---|
| 2 | ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
|
|---|
| 3 | D EN^LRUA S (LR("W"),LRS(5),LRQ(9),LRQ(3))=1,LRSDT=9999999-LRSDT,LRP=0
|
|---|
| 4 | F LRB=0:0 S LRP=$O(^TMP("LRAP",$J,LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP("LRAP",$J,LRP,LRDFN)) Q:'LRDFN!(LR("Q")) S X=^(LRDFN) D L
|
|---|
| 5 | Q
|
|---|
| 6 | L S DFN=$P(X,"^",2),LRQ=0,SEX=$P(X,"^",4),SSN=$P(X,"^"),Y=$P(X,"^",3) S DOB=$$FMTE^XLFDT(Y)
|
|---|
| 7 | G:'$D(^LR(LRDFN,"SP"))&('$D(^LR(LRDFN,"CY")))&('$D(^LR(LRDFN,"EM"))) AU
|
|---|
| 8 | D ^LRAPT1 Q:LR("Q")
|
|---|
| 9 | AU I $D(^LR(LRDFN,"AU")),+^("AU") D ^LRAPT2
|
|---|
| 10 | Q:'DFN!(LR("Q")) D INP^VADPT Q:VAIN(1)']"" D A
|
|---|
| 11 | Q
|
|---|
| 12 | A S LRPTF=VAIN(10)
|
|---|
| 13 | S LRADM=$P(VAIN(7),U,2)
|
|---|
| 14 | S LRWARD=$P(VAIN(4),U,2)
|
|---|
| 15 | S LRTS=$P(VAIN(3),U,2)
|
|---|
| 16 | K VAIN
|
|---|
| 17 | W !,"Adm: ",$P(LRADM,"@"),?35,LRWARD
|
|---|
| 18 | W !,?12,"Specialty: ",$P(LRADM,"@"),?35,LRTS
|
|---|
| 19 | Q:'LRPTF
|
|---|
| 20 | I $D(^DGPT(LRPTF,70)),$P(^(70),"^",10) S W=^(70) F X=10,11,16:1:24 I $P(W,"^",X) S LRF($P(W,"^",X))=""
|
|---|
| 21 | F Y=0:0 S Y=$O(^DGPT(LRPTF,"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))=""
|
|---|
| 22 | I $D(^DGPT(LRPTF,"401P")) S W=^("401P") F X=1:1:5 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 23 | F Y=0:0 S Y=$O(^DGPT(LRPTF,"P",Y)) Q:'Y S W=^(Y,0) F X=5:1:9 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 24 | F Y=0:0 S Y=$O(^DGPT(LRPTF,"S",Y)) Q:'Y S W=^(Y,0) F X=8:1:12 I $P(W,"^",X) S LRC($P(W,"^",X))=""
|
|---|
| 25 | F C=0:0 S C=$O(LRF(C)) Q:'C I $D(^ICD9(C)) S W=^(C,0) W !,$P(W,"^"),?10,$P(W,"^",3)
|
|---|
| 26 | F C=0:0 S C=$O(LRC(C)) Q:'C I $D(^ICD0(C)) S W=^(C,0) W !,$P(W,"^"),?10,$P(W,"^",4)
|
|---|
| 27 | Q
|
|---|
