LR7OU64.m

LR7OU64 ;SLC/DCM/FHS/DALISC - RESULT CODE NLT LINKING UTILITY AUTO ; 6/12/12 2:00

 ;;5.2;LAB SERVICE;**153,201,350**;Sep 27, 1994;Build 230

EN ;

 ;Find matches between file 64 and 60

 D MSG

LIST ;

 K DIR S DIR("A")="Would you like a list of RESULT NLT CODES from LABORATORY TEST file",DIR(0)="Y",DIR("B")="No"

 D ^DIR G:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) END I Y=1 D   G:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(Y=0) END G LK

 . D LST K DIR S DIR("A")="Ready to start linkage procedure ",DIR(0)="Y"

 . D ^DIR

 W ! K DIR S DIR("A")="Ready to proceed",DIR(0)="Y"

 D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(Y'=1) END

LK W !!,$$CJ^XLFSTR("Do you want to automatically link entries when there is an exact match",80)

 W !,$$CJ^XLFSTR("on the NAME in both files",80) S %=2 D YN^DICN G:%=-1 END

 I %=0 W !!,$$CJ^XLFSTR("Answer YES to automatically link the entries, or NO to be prompted for each",80) G LK

 S AUTO=$S(%=1:1,1:0)

LAB ;

 W:$G(AUTO) !?5,"Press Return to Stop Auto Update",!

 S (END,LRN)="" F  S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(END))  D

 . S LRIEN="" F  S LRIEN=+$O(^LAB(60,"B",LRN,LRIEN)) Q:LRIEN<1!($G(END))  I '$G(^(LRIEN)) D CHECK

 W:'$G(END) !!,$$CJ^XLFSTR("End of loop",80),!

 G END

 Q

CHECK ;

 S LRMIEN=0

 Q:'$D(^LAB(60,LRIEN,0))#2!('$P(^(0),";",2))!($P($G(^LAB(60,LRIEN,64)),U,2))!($G(END))

 S LRDATA=$P(^LAB(60,LRIEN,0),U),LRTY=$P(^(0),U,3) Q:LRTY=""!(LRTY="N")

 S LRNU=$$UP^XLFSTR(LRN),X=+$O(^LAM("D",LRNU,0)) I $D(^LAM(X,0)),^(0)'["~" S LRMIEN=X

 D:'LRMIEN 64 Q:'LRMIEN!($G(END))

 Q:'$D(^LAM(LRMIEN,0))#2  S LRCODE=$P(^(0),U,2) Q:'LRCODE!($D(^LAB(60,"AE",LRCODE)))

 Q:'$D(^LAM(LRMIEN,0))  S LRMNAME=$P(^(0),U)

 W !!,"60 = ",LRDATA,!,"64 = ",LRMNAME_"   "_LRCODE

 D LINK(LRIEN,LRMIEN,AUTO)

 Q

64 ;Look for NATIONAL VA LAB CODE

 S LRMIEN=0,I=+$P($G(^LAB(60,LRIEN,64)),U,2) I $D(^LAM(I,0)),^(0)'["~" S LRMIEN=I

 Q:'LRMIEN

 W !,$C(7),?5,"Did not find a exact name match for Lab Test "_LRDATA,!

 K DIR

 W !," Want to use the ["_$P(^LAM(LRMIEN,0),U)_"] NATIONAL VA LAB CODE instead?"

 K DIR S DIR(0)="Y" D ^DIR S:Y'=1 LRMIEN=0 Q

 Q

LINK(X60,X641,DOIT) ;Link the 2 files

 S LRDATA="`"_X60 I DOIT S %=1 G L2

L1 W !?5,"Link the two entries" S %=2 D YN^DICN Q:%=2  I %=-1 S END=1 Q

 I $G(DTOUT) S END=1 Q

 I %=0 W !,"Enter Yes to link the entries, No to leave it alone." G L1

L2 K DIE,DA,DR,DIC S DIE="^LAB(60,",DA=X60,DR="64.1///`"_X641,DLAYGO=60 D ^DIE K DLAYGO

 I $P($G(^LAB(60,X60,64)),U,2) W !?32,"o----LINKED----o",! D  Q

 . R X:1 I $T W !?20,"User terminated update",!,$C(7) S END=1

 W !!?15,"***************** NOT LINKED ***************",!

 W !!?5,"Press Return to continue" R X:DTIME S:$G(DTOUT)!($E(X)=U) END=1

 Q

END ;

 Q:$G(LRDBUG)

 K %,AUTO,DA,DIC,DIE,DIR,DOIT,DR,END,LRDATA,LRIEN,LRMIEN,LRN,LRNU

 K LRSUF,LRTY,X,X60,X64,Y,LRMNAME,D1,D0,DLAYGO,I,LRCODE,END

 K FLG,XXX,ZZ,ZZ1,X,Y,Y64,DLAYGO,DX,S

 Q

LST ;

 K ^TMP("LR",$J),DIC I $O(^LAB(60,"AE",0))="" W !,"Nothing in X-Ref to Print.",!! Q

 W !!,$$CJ^XLFSTR("I will produce a list of ",80)

 W !,$$CJ^XLFSTR("NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!

 K %ZIS S %ZIS="QN",%ZIS("A")="Printer Name " D ^%ZIS G:POP CLEAN

 I IO'=IO(0)!($D(IO("Q"))) S ZTRTN="DQ^LR7OU64",ZTIO=ION,ZTDESC="PRINT NLT CODES FROM ^LAB(60 " W !!?10,"Report Queued to "_ION,! D ^%ZTLOAD,^%ZISC G CLEAN

DQ K ^TMP("LR",$J),DX S:$D(ZTQUEUED) ZTREQ="@"

 W !!,$$CJ^XLFSTR("List of NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!!

 W ?6,$$NOW^XLFDT,!

 S LRNLT="" F  S LRNLT=$O(^LAB(60,"AE",LRNLT)) Q:LRNLT=""  D

 . S LRLAB=0 F  S LRLAB=$O(^LAB(60,"AE",LRNLT,LRLAB)) Q:LRLAB<1  D

 . . S ^TMP("LR",$J,$P(^LAB(60,LRLAB,0),U),LRNLT)=LRLAB

 S DIC="^LAB(60,"

 S NODE="^TMP(""LR"","_$J_")" F  S NODE=$Q(@NODE) Q:$QS(NODE,2)'=$J  D

 . S DA=@NODE,DR=64 W !,"Test Name: ",$P(^LAB(60,DA,0),U)

 . D EN^LRDIQ S:$E(IOST,1,2)="P-" S=0

CLEAN K DIC,DA,NODE,LRNLT,LRLAB,DR,DX,S,^TMP("LR",$J)

 Q

MSG W !,$$CJ^XLFSTR("This option will Auto Link NLT RESULT CODE to Laboratory test file (#60).",80)

 W !,$$CJ^XLFSTR("NLT RESULT CODE is used by the LEDI software to identify",80)

 W !,$$CJ^XLFSTR("test results returned by Host Laboratories.",80)

 W !,$$CJ^XLFSTR("ONLY GENERIC NLT CODES CAN BE LINKED TO LAB TEST ",80),!!

 W !,$$CJ^XLFSTR("Only ATOMIC lab tests can have an NLT RESULT CODE.",80),!   ;[ccr-8218]

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LR7OU64   4356     printed  Apr 23, 2025@18:19:51                                                                                                                                                                                                     Page 2

LR7OU64   ;SLC/DCM/FHS/DALISC - RESULT CODE NLT LINKING UTILITY AUTO ; 6/12/12 2:00

 +1       ;;5.2;LAB SERVICE;**153,201,350**;Sep 27, 1994;Build 230

EN        ;

 +1       ;Find matches between file 64 and 60

 +2        DO MSG

LIST      ;

 +1        KILL DIR

           SET DIR("A")="Would you like a list of RESULT NLT CODES from LABORATORY TEST file"

           SET DIR(0)="Y"

           SET DIR("B")="No"

 +2        DO ^DIR

           if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))

               GOTO END

           IF Y=1

               Begin DoDot:1

 +3                DO LST

                   KILL DIR

                   SET DIR("A")="Ready to start linkage procedure "

                   SET DIR(0)="Y"

 +4                DO ^DIR

               End DoDot:1

               if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))!(Y=0)

                   GOTO END

               GOTO LK

 +5        WRITE !

           KILL DIR

           SET DIR("A")="Ready to proceed"

           SET DIR(0)="Y"

 +6        DO ^DIR

           if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))!(Y'=1)

               GOTO END

LK         WRITE !!,$$CJ^XLFSTR("Do you want to automatically link entries when there is an exact match",80)

 +1        WRITE !,$$CJ^XLFSTR("on the NAME in both files",80)

           SET %=2

           DO YN^DICN

           if %=-1

               GOTO END

 +2        IF %=0

               WRITE !!,$$CJ^XLFSTR("Answer YES to automatically link the entries, or NO to be prompted for each",80)

               GOTO LK

 +3        SET AUTO=$SELECT(%=1:1,1:0)

LAB       ;

 +1        if $GET(AUTO)

               WRITE !?5,"Press Return to Stop Auto Update",!

 +2        SET (END,LRN)=""

           FOR 

               SET LRN=$ORDER(^LAB(60,"B",LRN))

               if LRN=""!($GET(END))

                   QUIT 

               Begin DoDot:1

 +3                SET LRIEN=""

                   FOR 

                       SET LRIEN=+$ORDER(^LAB(60,"B",LRN,LRIEN))

                       if LRIEN<1!($GET(END))

                           QUIT 

                       IF '$GET(^(LRIEN))

                           DO CHECK

               End DoDot:1

 +4        if '$GET(END)

               WRITE !!,$$CJ^XLFSTR("End of loop",80),!

 +5        GOTO END

 +6        QUIT 

CHECK     ;

 +1        SET LRMIEN=0

 +2        if '$DATA(^LAB(60,LRIEN,0))#2!('$PIECE(^(0),";",2))!($PIECE($GET(^LAB(60,LRIEN,64)),U,2))!($GET(END))

               QUIT 

 +3        SET LRDATA=$PIECE(^LAB(60,LRIEN,0),U)

           SET LRTY=$PIECE(^(0),U,3)

           if LRTY=""!(LRTY="N")

               QUIT 

 +4        SET LRNU=$$UP^XLFSTR(LRN)

           SET X=+$ORDER(^LAM("D",LRNU,0))

           IF $DATA(^LAM(X,0))

               IF ^(0)'["~"

                   SET LRMIEN=X

 +5        if 'LRMIEN

               DO 64

           if 'LRMIEN!($GET(END))

               QUIT 

 +6        if '$DATA(^LAM(LRMIEN,0))#2

               QUIT 

           SET LRCODE=$PIECE(^(0),U,2)

           if 'LRCODE!($DATA(^LAB(60,"AE",LRCODE)))

               QUIT 

 +7        if '$DATA(^LAM(LRMIEN,0))

               QUIT 

           SET LRMNAME=$PIECE(^(0),U)

 +8        WRITE !!,"60 = ",LRDATA,!,"64 = ",LRMNAME_"   "_LRCODE

 +9        DO LINK(LRIEN,LRMIEN,AUTO)

 +10       QUIT 

64        ;Look for NATIONAL VA LAB CODE

 +1        SET LRMIEN=0

           SET I=+$PIECE($GET(^LAB(60,LRIEN,64)),U,2)

           IF $DATA(^LAM(I,0))

               IF ^(0)'["~"

                   SET LRMIEN=I

 +2        if 'LRMIEN

               QUIT 

 +3        WRITE !,$CHAR(7),?5,"Did not find a exact name match for Lab Test "_LRDATA,!

 +4        KILL DIR

 +5        WRITE !," Want to use the ["_$PIECE(^LAM(LRMIEN,0),U)_"] NATIONAL VA LAB CODE instead?"

 +6        KILL DIR

           SET DIR(0)="Y"

           DO ^DIR

           if Y'=1

               SET LRMIEN=0

           QUIT 

 +7        QUIT 

LINK(X60,X641,DOIT) ;Link the 2 files

 +1        SET LRDATA="`"_X60

           IF DOIT

               SET %=1

               GOTO L2

L1         WRITE !?5,"Link the two entries"

           SET %=2

           DO YN^DICN

           if %=2

               QUIT 

           IF %=-1

               SET END=1

               QUIT 

 +1        IF $GET(DTOUT)

               SET END=1

               QUIT 

 +2        IF %=0

               WRITE !,"Enter Yes to link the entries, No to leave it alone."

               GOTO L1

L2         KILL DIE,DA,DR,DIC

           SET DIE="^LAB(60,"

           SET DA=X60

           SET DR="64.1///`"_X641

           SET DLAYGO=60

           DO ^DIE

           KILL DLAYGO

 +1        IF $PIECE($GET(^LAB(60,X60,64)),U,2)

               WRITE !?32,"o----LINKED----o",!

               Begin DoDot:1

 +2                READ X:1

                   IF $TEST

                       WRITE !?20,"User terminated update",!,$CHAR(7)

                       SET END=1

               End DoDot:1

               QUIT 

 +3        WRITE !!?15,"***************** NOT LINKED ***************",!

 +4        WRITE !!?5,"Press Return to continue"

           READ X:DTIME

           if $GET(DTOUT)!($EXTRACT(X)=U)

               SET END=1

 +5        QUIT 

END       ;

 +1        if $GET(LRDBUG)

               QUIT 

 +2        KILL %,AUTO,DA,DIC,DIE,DIR,DOIT,DR,END,LRDATA,LRIEN,LRMIEN,LRN,LRNU

 +3        KILL LRSUF,LRTY,X,X60,X64,Y,LRMNAME,D1,D0,DLAYGO,I,LRCODE,END

 +4        KILL FLG,XXX,ZZ,ZZ1,X,Y,Y64,DLAYGO,DX,S

 +5        QUIT 

LST       ;

 +1        KILL ^TMP("LR",$JOB),DIC

           IF $ORDER(^LAB(60,"AE",0))=""

               WRITE !,"Nothing in X-Ref to Print.",!!

               QUIT 

 +2        WRITE !!,$$CJ^XLFSTR("I will produce a list of ",80)

 +3        WRITE !,$$CJ^XLFSTR("NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!

 +4        KILL %ZIS

           SET %ZIS="QN"

           SET %ZIS("A")="Printer Name "

           DO ^%ZIS

           if POP

               GOTO CLEAN

 +5        IF IO'=IO(0)!($DATA(IO("Q")))

               SET ZTRTN="DQ^LR7OU64"

               SET ZTIO=ION

               SET ZTDESC="PRINT NLT CODES FROM ^LAB(60 "

               WRITE !!?10,"Report Queued to "_ION,!

               DO ^%ZTLOAD

               DO ^%ZISC

               GOTO CLEAN

DQ         KILL ^TMP("LR",$JOB),DX

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        WRITE !!,$$CJ^XLFSTR("List of NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!!

 +2        WRITE ?6,$$NOW^XLFDT,!

 +3        SET LRNLT=""

           FOR 

               SET LRNLT=$ORDER(^LAB(60,"AE",LRNLT))

               if LRNLT=""

                   QUIT 

               Begin DoDot:1

 +4                SET LRLAB=0

                   FOR 

                       SET LRLAB=$ORDER(^LAB(60,"AE",LRNLT,LRLAB))

                       if LRLAB<1

                           QUIT 

                       Begin DoDot:2

 +5                        SET ^TMP("LR",$JOB,$PIECE(^LAB(60,LRLAB,0),U),LRNLT)=LRLAB

                       End DoDot:2

               End DoDot:1

 +6        SET DIC="^LAB(60,"

 +7        SET NODE="^TMP(""LR"","_$JOB_")"

           FOR 

               SET NODE=$QUERY(@NODE)

               if $QSUBSCRIPT(NODE,2)'=$JOB

                   QUIT 

               Begin DoDot:1

 +8                SET DA=@NODE

                   SET DR=64

                   WRITE !,"Test Name: ",$PIECE(^LAB(60,DA,0),U)

 +9                DO EN^LRDIQ

                   if $EXTRACT(IOST,1,2)="P-"

                       SET S=0

               End DoDot:1

CLEAN      KILL DIC,DA,NODE,LRNLT,LRLAB,DR,DX,S,^TMP("LR",$JOB)

 +1        QUIT 

MSG        WRITE !,$$CJ^XLFSTR("This option will Auto Link NLT RESULT CODE to Laboratory test file (#60).",80)

 +1        WRITE !,$$CJ^XLFSTR("NLT RESULT CODE is used by the LEDI software to identify",80)

 +2        WRITE !,$$CJ^XLFSTR("test results returned by Host Laboratories.",80)

 +3        WRITE !,$$CJ^XLFSTR("ONLY GENERIC NLT CODES CAN BE LINKED TO LAB TEST ",80),!!

 +4       ;[ccr-8218]

           WRITE !,$$CJ^XLFSTR("Only ATOMIC lab tests can have an NLT RESULT CODE.",80),!

 +5        QUIT