LRHY22.m

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 ---LRHY22   1242     printed  Apr 09, 2024@21:15:37                                                                                                                                                                                                      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