LRUCE.m

LRUCE ; IHS/DIR/FJE - LAB COMMENT EDIT 6/2/86 9:03 AM ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

DATE S %DT="AEX",%DT("A")="ENTER WORKLIST DATE: " D ^%DT Q:Y<1

 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

 I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!! G DATE

LRAN W !!,LRH(0),?14," Acc # : " R LRAN:DTIME Q:LRAN=""!(LRAN["^")  I LRAN'?1N.N W $C(7),!!,"NUMBERS ONLY" G LRAN

 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession #",LRAN," for ",LRH(0)," not in ACCESSION file",!! G LRAN

 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0) Q:'$D(^LR(LRDFN,0))

 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

 S LRI=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):$P(^(3),"^",5),1:"") Q:'LRI

ASK L +^LR(LRDFN,SBSC,LRI):1 I '$T W !?7,"Someone else is editing this Patient ",!!,$C(7) Q

 S DIE="^LR(LRDFN,SBSC,",DA=LRI,DR=".99;S LRC(5)=X" D ^DIE Q:$D(Y)

 S ^LRO(68,LRAA,1,LRAD,1,LRAN,3)=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",1,5)_"^"_LRC(5)

 L -^LR(LRDFN,SBSC,LRI) Q

LRUCE     ; IHS/DIR/FJE - LAB COMMENT EDIT 6/2/86 9:03 AM ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

DATE       SET %DT="AEX"

           SET %DT("A")="ENTER WORKLIST DATE: "

           DO ^%DT

           IF Y<1

               QUIT 

 +1        SET LRAD=$SELECT($PIECE(^LRO(68,LRAA,0),"^",3)="Y":$EXTRACT(Y,1,3)_"0000",1:Y)

           SET Y=LRAD

           DO D^LRU

           SET LRH(0)=Y

 +2        IF '$DATA(^LRO(68,LRAA,1,LRAD,0))

               WRITE $CHAR(7),!!,"NO ",LRAA(1)," ACCESSIONS IN FILE FOR ",LRH(0),!!

               GOTO DATE

LRAN       WRITE !!,LRH(0),?14," Acc # : "

           READ LRAN:DTIME

           IF LRAN=""!(LRAN["^")

               QUIT 

           IF LRAN'?1N.N

               WRITE $CHAR(7),!!,"NUMBERS ONLY"

               GOTO LRAN

 +1        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

               WRITE $CHAR(7),!!,"Accession #",LRAN," for ",LRH(0)," not in ACCESSION file",!!

               GOTO LRAN

 +2        SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)

           IF '$DATA(^LR(LRDFN,0))

               QUIT 

 +3        SET LRPF=^DIC($PIECE(^LR(LRDFN,0),"^",2),0,"GL")

           SET LRFLN=+$PIECE(@(LRPF_"0)"),"^",2)

           SET DFN=$PIECE(^LR(LRDFN,0),"^",3)

           SET LRP=@(LRPF_DFN_",0)")

           SET LRLLOC=$SELECT($DATA(^(.1)):^(.1),1:"")

           WRITE !,$PIECE(LRP,"^"),?30,"ID: ",$PIECE(LRP,"^",9),"  ",LRLLOC

 +4        SET LRI=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):$PIECE(^(3),"^",5),1:"")

           IF 'LRI

               QUIT 

ASK        LOCK +^LR(LRDFN,SBSC,LRI):1

           IF '$TEST

               WRITE !?7,"Someone else is editing this Patient ",!!,$CHAR(7)

               QUIT 

 +1        SET DIE="^LR(LRDFN,SBSC,"

           SET DA=LRI

           SET DR=".99;S LRC(5)=X"

           DO ^DIE

           IF $DATA(Y)

               QUIT 

 +2        SET ^LRO(68,LRAA,1,LRAD,1,LRAN,3)=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",1,5)_"^"_LRC(5)

 +3        LOCK -^LR(LRDFN,SBSC,LRI)

           QUIT