| [613] | 1 | LRUPS ;AVAMC/REG/WTY - PATIENT SPEC LOOK-UP ;3/20/01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,248,259,322,362**;Sep 27, 1994;Build 11
|
|---|
| 3 | ;Removed space between "No data" at tag EN
|
|---|
| 4 | ;
|
|---|
| 5 | GETP W ! K LRAN,DIC S X="",DFN=-1,DIC(0)="EQM",(LRX,LRDPF)="" D DPA^LRDPA
|
|---|
| 6 | I DFN=-1 S LRAN=-1 Q
|
|---|
| 7 | I N LRAY
|
|---|
| 8 | I '$D(LRPFLG) N LRPFLG S LRPFLG=0
|
|---|
| 9 | I LRSS="AU" G AU
|
|---|
| 10 | EN I '$D(^LR(LRDFN,LRSS))!($P($G(^LR(LRDFN,LRSS,0)),U,3)<1) W $C(7),!!,"No data for ",PNM G GETP
|
|---|
| 11 | S (LRI,LRLIDT,E)=0 S:'$D(LRABV) LRABV=0
|
|---|
| 12 | I "CYEMSP"'[LRSS W !!,"Count #",?10,"Accession #",?29,"Date",?45,"Site/specimen"
|
|---|
| 13 | E W !!,"Specimen(s)",?30,"Count #",?40,"Accession #",?55,"Date Obtained"
|
|---|
| 14 | S C=0
|
|---|
| 15 | F S LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI!(E) D
|
|---|
| 16 | .S X=$G(^LR(LRDFN,LRSS,LRI,0)) Q:X="" S LRAC=$P(X,U,6)
|
|---|
| 17 | .I $P(LRAC," ")=LRABV!(LRABV=0) D WT:C#5=0 Q:E D
|
|---|
| 18 | ..S LRAY=$P(LRAC," ",2)
|
|---|
| 19 | ..I LRPFLG,LRAY'=$E(LRAD,2,3) Q
|
|---|
| 20 | ..S C=C+1,LRAN=+$P(LRAC," ",3)
|
|---|
| 21 | ..S LRAN(C)=LRI_U_LRAN,LRLIDT=LRI
|
|---|
| 22 | ..S Y=$P(X,U),LRST=$P(X,U,5) D D^LRU,@($S("CYEMSP"[LRSS:"SP",1:"CY"))
|
|---|
| 23 | I 'C W !!,"No specimens entered for "_LRH(0) G GETP
|
|---|
| 24 | I C=1 S LRI=+LRAN(1),Y(0)=^LR(LRDFN,LRSS,LRI,0),LRTK=+Y(0) G L
|
|---|
| 25 | ACC W !?11,"Choose Count #(1-",C,"): " R X:DTIME I X=""!(X[U) S LRAN=-1 Q
|
|---|
| 26 | I X'?1N.N W $C(7),!!,"Enter numbers only",!! G ACC
|
|---|
| 27 | OK I '$D(LRAN(X)) W " Doesn't exist for ",PNM G ACC
|
|---|
| 28 | GOT S LRI=+LRAN(X),Y(0)=^LR(LRDFN,LRSS,LRI,0),LRTK=+Y(0)
|
|---|
| 29 | L S LRAC=$P(Y(0),U,6),LRAN=+$P(LRAC," ",3),Y=$P(Y(0),U) D D^LRU W !!," Accession #: ",LRAC W:Y'[1700 " Date Obtained: ",Y,! S LRWW=$S(Y'[1700:Y,1:"")
|
|---|
| 30 | Q
|
|---|
| 31 | WT I C>0 W !,"More accessions " S %=2 D YN^LRU S E=$S(%=1:0,1:1) Q
|
|---|
| 32 | Q
|
|---|
| 33 | SP W !?30,"(",$J(C,2),")",?40,LRAC,?55,Y I '$P(X,"^",11) W " not verified"
|
|---|
| 34 | S LRST=0 F A=0:1 S LRST=$O(^LR(LRDFN,LRSS,LRI,.1,LRST)) Q:'LRST W:$D(^(LRST,0)) !,$P(^(0),"^")
|
|---|
| 35 | Q
|
|---|
| 36 | CY W !?2,"(",$J(C,2),")",?10,LRAC,?25,Y W:LRST ?45,$S($D(^LAB(61,LRST,0)):$E($P(^(0),U),1,34),1:"") Q
|
|---|
| 37 | AU S LRND=$G(^LR(LRDFN,"AU"))
|
|---|
| 38 | I '$L(LRND) W $C(7),!!,"No autopsy entry for ",LRP,!! S LRAN="?" Q
|
|---|
| 39 | S LRAC=$P(LRND,U,6)
|
|---|
| 40 | I $P(LRAC," ")'=LRABV W $C(7),!!,"No autopsy accession" S LRAN="?" Q
|
|---|
| 41 | S LRAY=$P(LRAC," ",2)
|
|---|
| 42 | I LRPFLG,LRAY'=$E(LRAD,2,3) D Q
|
|---|
| 43 | .W $C(7),!!,"No autopsy accession for "_LRH(0) S LRAN="?"
|
|---|
| 44 | S LRAN=+$P(LRAC," ",3)
|
|---|
| 45 | I 'LRAN S LRAN=-1 W $C(7),!!,"No autopsy # for ",LRP Q
|
|---|
| 46 | S Y=+LRND D D^LRU W !,"Autopsy performed: ",Y," Acc # ",LRAC
|
|---|
| 47 | Q
|
|---|
| 48 | EN1 ;from LRAPMOD, LRSPRPT, LRSPT
|
|---|
| 49 | W ! K DIC,LRAN S DIC(0)="EQM",(LRX,LRDPF)="" D DPA^LRDPA I DFN=-1 S LRAN=-1 Q
|
|---|
| 50 | G I
|
|---|
