LRHY22 ;DALOI/HOAK - HOWDY DEL A DUPLICATE TEST ;10/15/2010
;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
;
EN1 S LREND=0,LRSN=+LRT(LRJ),LRTSTI=+$P(LRT(LRJ),U,2),LRTSTS=+$P(LRT(LRJ),U,3)
N LRODT
S LRODT=LR3DTN
I '$D(^LRO(69,LRODT,1,LRSN,2,LRTSTI,0))#2 W !,"Does not exist ",! Q
S LRX=^LRO(69,LRODT,1,LRSN,2,LRTSTI,0),LRAD=+$P(LRX,U,3),LRAA=+$P(LRX,U,4),LRAN=+$P(LRX,U,5),LRNOP=0,LRONE="",LRACC=0,ORIFN=$P(LRX,U,7)
S LRSS=$P($G(^LRO(68,LRAA,0)),U,2)
S LRTNM=$P($G(^LAB(60,LRTSTS,0)),U)
S LRNATURE="LAB"
I '$L($G(LRNATURE)) D DC^LROR6() I $G(LRNATURE)=-1 W !!,$C(7),"NOTHING CHANGED" Q
S LRIDT=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
I LRIDT L +^LR(LRDFN,LRSS,LRIDT):$G(DILOCKTM,3) I '$T W !?5,"Someone else is editing this entry",! S LREND=1 Q
Q:$G(LRSS)["MI"
D SET^LRHYDEL I LRIDT L -^LR(LRDFN,LRSS,LRIDT)
I $G(LRORD) L -^LRO(69,"C",+LRORD)
;
Q
END K %,AGE,DFN,DIC,DIE,DOB,DQ,DR,J,LRAA,LRACC,LRACN0,LRAD,LRAN,LRCL,LRHYCT,LRCOL,LRDOC,LRDPF,LRDTM,LREND,LRIDT
K LRNOW,LRLL,LRLLOC,LRNOP,LROD0,LROD1,LROD3,LRODT,LROOS,LRORD,LROS,LROSD,LROT,LROV,LRROD
K LRSCNXB,LRSN,LRSPEC,LRSS,LRTC,LRTP,LRTSTS,LRT,LRTT,LRURG,LRUSI,LRUSNM,LRWRD,PNM,SEX,SSN,T,X,X1,X2,X3,X4,Y,Z,LRNATURE,ORIFN
K LRACN,LRJ,LRTSTI
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRHY22 1242 printed Nov 22, 2024@17:25:13 Page 2
LRHY22 ;DALOI/HOAK - HOWDY DEL A DUPLICATE TEST ;10/15/2010
+1 ;;5.2;LAB SERVICE;**405**;Sep 27, 1994;Build 93
+2 ;
EN1 SET LREND=0
SET LRSN=+LRT(LRJ)
SET LRTSTI=+$PIECE(LRT(LRJ),U,2)
SET LRTSTS=+$PIECE(LRT(LRJ),U,3)
+1 NEW LRODT
+2 SET LRODT=LR3DTN
+3 IF '$DATA(^LRO(69,LRODT,1,LRSN,2,LRTSTI,0))#2
WRITE !,"Does not exist ",!
QUIT
+4 SET LRX=^LRO(69,LRODT,1,LRSN,2,LRTSTI,0)
SET LRAD=+$PIECE(LRX,U,3)
SET LRAA=+$PIECE(LRX,U,4)
SET LRAN=+$PIECE(LRX,U,5)
SET LRNOP=0
SET LRONE=""
SET LRACC=0
SET ORIFN=$PIECE(LRX,U,7)
+5 SET LRSS=$PIECE($GET(^LRO(68,LRAA,0)),U,2)
+6 SET LRTNM=$PIECE($GET(^LAB(60,LRTSTS,0)),U)
+7 SET LRNATURE="LAB"
+8 IF '$LENGTH($GET(LRNATURE))
DO DC^LROR6()
IF $GET(LRNATURE)=-1
WRITE !!,$CHAR(7),"NOTHING CHANGED"
QUIT
+9 SET LRIDT=+$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
+10 IF LRIDT
LOCK +^LR(LRDFN,LRSS,LRIDT):$GET(DILOCKTM,3)
IF '$TEST
WRITE !?5,"Someone else is editing this entry",!
SET LREND=1
QUIT
+11 if $GET(LRSS)["MI"
QUIT
+12 DO SET^LRHYDEL
IF LRIDT
LOCK -^LR(LRDFN,LRSS,LRIDT)
+13 IF $GET(LRORD)
LOCK -^LRO(69,"C",+LRORD)
+14 ;
+15 QUIT
END KILL %,AGE,DFN,DIC,DIE,DOB,DQ,DR,J,LRAA,LRACC,LRACN0,LRAD,LRAN,LRCL,LRHYCT,LRCOL,LRDOC,LRDPF,LRDTM,LREND,LRIDT
+1 KILL LRNOW,LRLL,LRLLOC,LRNOP,LROD0,LROD1,LROD3,LRODT,LROOS,LRORD,LROS,LROSD,LROT,LROV,LRROD
+2 KILL LRSCNXB,LRSN,LRSPEC,LRSS,LRTC,LRTP,LRTSTS,LRT,LRTT,LRURG,LRUSI,LRUSNM,LRWRD,PNM,SEX,SSN,T,X,X1,X2,X3,X4,Y,Z,LRNATURE,ORIFN
+3 KILL LRACN,LRJ,LRTSTI
+4 QUIT
