- LRUCE ;AVAMC/REG - LAB COMMENT EDIT ; 6/2/86 9:03 AM ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUCE 1198 printed Feb 18, 2025@23:47:11 Page 2
- LRUCE ;AVAMC/REG - LAB COMMENT EDIT ; 6/2/86 9:03 AM ;
- +1 ;;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