source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUCE.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LRUCE ;AVAMC/REG - LAB COMMENT EDIT ; 6/2/86 9:03 AM ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3DATE S %DT="AEX",%DT("A")="ENTER WORKLIST DATE: " D ^%DT Q:Y<1
4 S LRAD=$S($P(^LRO(68,LRAA,0),"^",3)="Y":$E(Y,1,3)_"0000",1:Y),Y=LRAD D D^LRU S LRH(0)=Y
5 I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!! G DATE
6LRAN W !!,LRH(0),?14," Acc # : " R LRAN:DTIME Q:LRAN=""!(LRAN["^") I LRAN'?1N.N W $C(7),!!,"NUMBERS ONLY" G LRAN
7 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession #",LRAN," for ",LRH(0)," not in ACCESSION file",!! G LRAN
8 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0) Q:'$D(^LR(LRDFN,0))
9 S LRPF=^DIC($P(^LR(LRDFN,0),"^",2),0,"GL"),LRFLN=+$P(@(LRPF_"0)"),"^",2),DFN=$P(^LR(LRDFN,0),"^",3),LRP=@(LRPF_DFN_",0)"),LRLLOC=$S($D(^(.1)):^(.1),1:"") W !,$P(LRP,"^"),?30,"ID: ",$P(LRP,"^",9)," ",LRLLOC
10 S LRI=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):$P(^(3),"^",5),1:"") Q:'LRI
11ASK L +^LR(LRDFN,SBSC,LRI):1 I '$T W !?7,"Someone else is editing this Patient ",!!,$C(7) Q
12 S DIE="^LR(LRDFN,SBSC,",DA=LRI,DR=".99;S LRC(5)=X" D ^DIE Q:$D(Y)
13 S ^LRO(68,LRAA,1,LRAD,1,LRAN,3)=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",1,5)_"^"_LRC(5)
14 L -^LR(LRDFN,SBSC,LRI) Q
Note: See TracBrowser for help on using the repository browser.