| [613] | 1 | LRAPBS1 ;AVAMC/REG - BLOCK/SLIDE DATA ENTRY;3/25/2002
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,259**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ASK N CORRECT,LRREL,LRMSG
|
|---|
| 5 | S %DT="",X="T" D ^%DT S LRY=$E(Y,1,3)+1700 W !!,"Enter year: ",LRY,"// " R X:DTIME G:'$T!(X[U) END S:X="" X=LRY
|
|---|
| 6 | S LRN="",%DT="EQ" D ^%DT G:Y<1 ASK S LRY=$E(Y,1,3),LRAD=$E(LRY,1,3)_"0000",LRH(0)=LRY+1700 W " ",LRH(0)
|
|---|
| 7 | I '$O(^LRO(68,LRAA,1,LRAD,1,0)) W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!! Q
|
|---|
| 8 | W ;
|
|---|
| 9 | K X,Y,LR("CK")
|
|---|
| 10 | W !!,"Select Accession Number: ",LRN,$S(LRN:"// ",1:"")
|
|---|
| 11 | R LRAN:DTIME
|
|---|
| 12 | I '$T!(LRAN[U)!(LRN=""&(LRAN="")) D END Q
|
|---|
| 13 | S:LRAN="" LRAN=LRN
|
|---|
| 14 | I LRAN'?1N.N S LRN="" W $C(7),!!,"Enter a number." G W
|
|---|
| 15 | S LRN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) S:LRN'=+LRN LRN=""
|
|---|
| 16 | D OE1^LR7OB63D,REST,OERR^LR7OB63D
|
|---|
| 17 | G W
|
|---|
| 18 | REST ;
|
|---|
| 19 | W " for ",LRH(0)
|
|---|
| 20 | I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D Q
|
|---|
| 21 | .W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in"
|
|---|
| 22 | .W " ACCESSION file",!!
|
|---|
| 23 | S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(X,"^",7),LRDFN=+X
|
|---|
| 24 | Q:'$D(^LR(LRDFN,0)) S X=^(0) D ^LRUP
|
|---|
| 25 | W !,LRP," ID: ",SSN
|
|---|
| 26 | Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRI=$P(^(3),"^",5)
|
|---|
| 27 | S LRA=$S("SPCYEM"[LRSS:^LR(LRDFN,LRSS,LRI,0),$D(^LR(LRDFN,"AU")):^("AU"),1:"")
|
|---|
| 28 | S LRRC=$S("SPCYEM"[LRSS:$P(LRA,"^",10),1:+LRA)
|
|---|
| 29 | ;K LRREL
|
|---|
| 30 | ;D RELEASE^LRAPUTL(.LRREL,LRDFN,LRSS,$G(LRI))
|
|---|
| 31 | ;I +$G(LRREL(1)) D Q
|
|---|
| 32 | ;.K LRMSG
|
|---|
| 33 | ;.S LRMSG=$C(7)_"Report verified. Cannot use this option."
|
|---|
| 34 | ;.D EN^DDIOL(LRMSG,"","!!")
|
|---|
| 35 | I LRSS="CY",LRCAPA D C^LRAPCWK Q:LRK<1
|
|---|
| 36 | W ! I "AUSPEM"[LRSS S %DT("A")=$S('$D(LRF):"Date/time blocks prepared/modified: ",1:"Date/time Gross Description/Cutting: ") D W^LRAPWU Q:Y<1 S LRK(1)=LRK D CK Q:'$D(Y) G:$D(LRF) A
|
|---|
| 37 | S %DT("A")="Date/time "_$S("AUSPCY"[LRSS:"slides stained: ",1:"sections prepared: ") D W^LRAPWU Q:Y<1 I LRSS="CY" D CK Q:'$D(Y)
|
|---|
| 38 | I "AUSPEM"[LRSS,Y<LRK(1) W $C(7),!,"Date/time must not be before date/time blocks prepared(" S Y=LRK(1),LRN="" D DD^%DT W Y,")." Q
|
|---|
| 39 | A D EN^LRAPBS2,EN^LRAPST W !!,"Data displayed ok " S %=2 D YN^LRU Q:%<1 I %=1 D EN^LRAPWKA Q
|
|---|
| 40 | I LRSS'="AU" S DIE="^LR("_LRDFN_","""_LRSS_""",",DA=LRI,DA(1)=LRDFN D CK^LRU Q:$D(LR("CK")) D ^DIE D FRE^LRU G A
|
|---|
| 41 | S DIE="^LR(",DA=LRDFN L +^LR(LRDFN,"AU"):1 I '$T W !,$C(7),"ANOTHER TERMINAL IS EDITING THIS ENTRY!" Q
|
|---|
| 42 | D ^DIE L -^LR(LRDFN,"AU") G A
|
|---|
| 43 | ;
|
|---|
| 44 | CK I LRK<LRRC W $C(7),!,"Date/time must not be before date/time ",$S("SPCYEM"[LRSS:"specimen received (",1:"autopsy performed (") S Y=LRRC D DD^%DT W Y,")" K Y S LRN=""
|
|---|
| 45 | Q
|
|---|
| 46 | SP S J=0,X="PARAFFIN BLOCK" D X^LRUWK S LRW(1)=LRT K LRT
|
|---|
| 47 | S X="PARAFFIN BLOCK, ADDITIONAL CUT" D X^LRUWK S LRW(0)=LRT K LRT
|
|---|
| 48 | S X="PLASTIC SECTION" D X^LRUWK S LRW(2)=LRT K LRT
|
|---|
| 49 | S X="FROZEN SECTION BLOCK RUSH" D X^LRUWK S LRW(3)=LRT K LRT
|
|---|
| 50 | S X="FROZEN SECTION BLOCK NOT RUSH" D X^LRUWK S LRW(4)=LRT K LRT
|
|---|
| 51 | S X="FROZEN SECTION BLOCK RUSH ADD" D X^LRUWK S LRW(5)=LRT K LRT
|
|---|
| 52 | S X="FROZEN SECTION ADDITIONAL CUT" D X^LRUWK S LRW(6)=LRT K LRT
|
|---|
| 53 | S X="FROZEN SECTION H & E" D X^LRUWK S LRW(7)=LRT K LRT Q
|
|---|
| 54 | AU S J=0,X="AUTOPSY SECTION COMPLETE" Q:'LRCAPA D X^LRUWK S LRW(1)=LRT K LRT
|
|---|
| 55 | S X="AUTOPSY H & E" D X^LRUWK S LRW(0)=LRT K LRT
|
|---|
| 56 | S X="AUTOPSY UNSTAINED SLIDE" D X^LRUWK S LRW(2)=LRT K LRT Q
|
|---|
| 57 | ;
|
|---|
| 58 | END D V^LRU Q
|
|---|
