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  Sep 23, 2025@19:50:48                                                                                                                                                                                                      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