Routine: LR7OU641

LR7OU641 ;SLC/DCM/DALOI/FHS - RESULT NLT LINKING UTILITY SEMI-MANUAL ; 12/3/1997

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**153,201,278,280**;Sep 27, 1994

EN ;

64 ;User assigns links between 60 (64.1) and 64 (NLT)

 K DX S LREND=0 D LLIST S LREND=0

 I '$O(^LAB(60,"AE",0)) D  H 5

 . W !?5,"You have not yet ran the Semi-automatic Linking of RESULT NLT  option",!

 . W !?20,"[LR70 641-64 AUTO]",!

 . W !,"IT IS STRONGLY RECOMMENDED YOU RUN THE AUTOMATIC OPTION FIRST",!!

 W !,$$CJ^XLFSTR("This option will allow you to assign RESULT NLT Code to Atomic Lab Tests.",80)

 W !,$$CJ^XLFSTR("You must select any WKLD CODE ",80)

 W !,$$CJ^XLFSTR("Tests with the type of NEITHER or null will be skipped in the Auto Mode.",80)

 W !,$$CJ^XLFSTR("ONLY ATOMIC LAB TEST YIELDING RESULTS SHOULD BE ASSIGNED RESULT CODES.",80),!!

 K DIR S DIR("A")="Print list of both NLT and RESULT NLT CODES from LABORATORY TEST file",DIR(0)="Y",DIR("B")="No"

 D ^DIR K DIR G:$D(DIRUT) END I Y=1 D   G:$D(DIRUT)!(Y=0) END G START

 . D ^LRCAPD K DIR S DIR("A")="Ready to start RESULT NLT CODE linkage procedure ",DIR(0)="Y"

 . D ^DIR K DIR

MSG ;

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

 D ^DIR K DIR G:$D(DIRUT)!(Y'=1) END

START W ! K DIR S DIR("A")="Select Linking Method ",DIR(0)="S^M:Manual;S:Semi-Auto",DIR("?")="Linking method description"

 W !!,$$CJ^XLFSTR(DIR("A"),80)

 F I=1:1 S LN=$P($T(TXT+I),";;",2) Q:LN="END"  S DIR("?",I)=LN W !,$$LJ^XLFSTR(LN,80)

 W !! K I,LN D ^DIR K DIR G:$D(DIRUT) END G:Y="M" SEL

LIST ;

 K DIR W !!?5,"Select a starting TEST NAME " R LRN:DTIME G:'$T!($E(LRN)="^") END

LK ;

 W ! S LRAUTO=0 S:$L(LRN)>1 LRN=$E(LRN,1,($L(LRN)-1))

LAB ;

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

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

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

 G END

CHECK ;

 Q:'$P(^LAB(60,LRIEN,0),";",2)

 K DIC Q:'$D(^LAB(60,LRIEN,0))#2!($P($G(^LAB(60,LRIEN,64)),U,2))!($G(LREND))

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

 S X60=LRIEN D SELX

END ;

 K DIRUT,LRAUTO,LRDATA,LREND,LRANS,LRIEN,LRN,LRNLT,LRTY,N,X,X60,Y,Y64,ZTSAVE

 D END^LR7OU64

SEL ;

 S LRAUTO=1

 I $G(LREND),LRAUTO=1 G END

 W @IOF

 K DIC,DIR,DR,DA,DIE S DIC("A")="You may select any ATOMIC test in LABORATORY TEST FILE: "

 S DIC="^LAB(60,",DIC(0)="AEQZMN",DIC("S")="I $P(^(0),"";"",2)" D ^DIC K DIC G:Y<1 END

 S LRDATA=$P(Y(0),U),(LRIEN,X60)=+Y

SELX L +^LAB(60,LRIEN):2

 I '$T W !?4,"Locked by another user" Q:'LRAUTO  G:LRAUTO SEL

 I $P($G(^LAB(60,X60,64)),U,2),$D(^LAM(+$P(^(64),U,2),0)) S Y64=^(0) D

 . W !!?5,"Currently linked to [ ",$P(Y64,U)_" ]   "_$P(Y64,U,2),!!

 W !!,"Now select a RESULT NLT CODE for "_LRDATA,!

 K DIC,DIE,DR,DA

 S DA=LRIEN,(DIC,DIE)="^LAB(60,",DR=64.1

 D ^DIE

 L -^LAB(60,LRIEN)

 I $D(Y) S LREND=1 Q

 W !!?3,"IEN: [",DA,"] ",$P(^LAB(60,LRIEN,0),U),"  RESULT NLT CODE: ",$$GET1^DIQ(60,LRIEN_",",64.1,"")

 K DA,DIC,DIE,DR

 Q:'$G(LRAUTO)

 K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) LREND=1 Q:$G(LREND)

 G SEL

TXT ;;

 ;;           Linking RESULT NLT CODE methods description

;;

 ;;                    ONLY ATOMIC LAB TEST

 ;;      YIELDING A RESULT CAN BE LINKED TO RESULT NLT CODES.

;;

 ;;(S) You can use the semi automated method, which will provide a

 ;;alphabetical listing of LABORATORY TEST names. The system will prompt

 ;;you for those tests not already assigned a RESULT NLT CODE.

 ;;Tests with null TYPE or with the type of NEITHER are excluded.

;;

 ;;(M) Using the Manual method, you are able to select ANY ATOMIC test

 ;;regardless of the type field in the LABORATORY TEST file,

 ;;and assign it a RESULT NLT CODE. If the test is already linked

 ;;the system will display the code and allow you to change

 ;;the RESULT NLT CODE assigned. This method will allow you to

 ;;change linked LABORATORY TEST to another RESULT NLT CODE.

 ;;END

LLIST ;

 K DIR

 S DIR("A")="Would you like a list of Result NLT linked codes"

 S DIR(0)="S^0:No;1:ALL;2:Linked;3:Unlinked"

 D ^DIR

 Q:$D(DIRUT)!(Y=0)

 S LRANS=Y

 K %ZIS

 S %ZIS="Q" D ^%ZIS

 I POP D HOME^%ZIS Q

 I $D(IO("Q")) D  Q

 . N ZTDESC,ZTRTN,ZTSAVE

 . S ZTRTN="DQ^LR7OU641",ZTSAVE("LRANS")="",ZTDESC="List of Result NLT Linked Codes"

 . D ^%ZTLOAD W !,$S($G(ZTSK):"Task Number "_ZTSK,1:"Failed to Queue Job")

 . D ^%ZISC

DQ U IO I $D(ZTQUEUED) S ZTREQ="@"

 W !!?5,"Listing of ",$S(LRANS=1:"ALL",LRANS=2:"LINKED",1:"UNLINKED")," Laboratory Test   [ ",$$HTE^XLFDT($H)," ] ",!!

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

 . F  S LRIEN=+$O(^LAB(60,"B",LRN,LRIEN)) Q:LRIEN<0!($G(^(LRIEN)))!($G(LREND))  Q:'$D(^LAB(60,LRIEN,0))  S LRTY=$P(^(0),U,3) Q:LRTY=""  D

 . . I LRANS=1 D PRT Q

 . . I LRANS=2,$P($G(^LAB(60,LRIEN,64)),U,2) D PRT Q

 . . I LRANS=3,'$P($G(^LAB(60,LRIEN,64)),U,2) D PRT Q

 W !?20,"****  End of Print List  ****",!!!

 W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q

PRT ;

 I $E(IOST,1,2)="C-",$Y>(IOSL-4) K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) LREND=1 Q:$G(LREND)  W @IOF

 W !?5,LRN,?45,"[ ",$S(LRTY="B":"BOTH",LRTY="N":"NEITHER",LRTY="O":"OUTPUT",1:"INPUT")," ]",!

 S LRNLT=$G(^LAB(60,LRIEN,64))

 I $D(^LAM(+$P(LRNLT,U),0)) W !,"National VA LAB CODE",?23,$P(^(0),U,2),"  ",$P(^(0),U)

 I $D(^LAM(+$P(LRNLT,U,2),0)) W !,"Result NLT Code",?23,$P(^(0),U,2),"  ",$P(^(0),U)

 W ! Q

LR7OU641  ;SLC/DCM/DALOI/FHS - RESULT NLT LINKING UTILITY SEMI-MANUAL ; 12/3/1997

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**153,201,278,280**;Sep 27, 1994

 +3       ;

EN        ;

64        ;User assigns links between 60 (64.1) and 64 (NLT)

 +1        KILL DX

           SET LREND=0

           DO LLIST

           SET LREND=0

 +2        IF '$ORDER(^LAB(60,"AE",0))

               Begin DoDot:1

 +3                WRITE !?5,"You have not yet ran the Semi-automatic Linking of RESULT NLT  option",!

 +4                WRITE !?20,"[LR70 641-64 AUTO]",!

 +5                WRITE !,"IT IS STRONGLY RECOMMENDED YOU RUN THE AUTOMATIC OPTION FIRST",!!

               End DoDot:1

               HANG 5

 +6        WRITE !,$$CJ^XLFSTR("This option will allow you to assign RESULT NLT Code to Atomic Lab Tests.",80)

 +7        WRITE !,$$CJ^XLFSTR("You must select any WKLD CODE ",80)

 +8        WRITE !,$$CJ^XLFSTR("Tests with the type of NEITHER or null will be skipped in the Auto Mode.",80)

 +9        WRITE !,$$CJ^XLFSTR("ONLY ATOMIC LAB TEST YIELDING RESULTS SHOULD BE ASSIGNED RESULT CODES.",80),!!

 +10       KILL DIR

           SET DIR("A")="Print list of both NLT and RESULT NLT CODES from LABORATORY TEST file"

           SET DIR(0)="Y"

           SET DIR("B")="No"

 +11       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           IF Y=1

               Begin DoDot:1

 +12               DO ^LRCAPD

                   KILL DIR

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

                   SET DIR(0)="Y"

 +13               DO ^DIR

                   KILL DIR

               End DoDot:1

               IF $DATA(DIRUT)!(Y=0)

                   GOTO END

               GOTO START

MSG       ;

 +1        WRITE !

           KILL DIR

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

           SET DIR(0)="Y"

 +2        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!(Y'=1)

               GOTO END

START      WRITE !

           KILL DIR

           SET DIR("A")="Select Linking Method "

           SET DIR(0)="S^M:Manual;S:Semi-Auto"

           SET DIR("?")="Linking method description"

 +1        WRITE !!,$$CJ^XLFSTR(DIR("A"),80)

 +2        FOR I=1:1

               SET LN=$PIECE($TEXT(TXT+I),";;",2)

               IF LN="END"

                   QUIT

               SET DIR("?",I)=LN

               WRITE !,$$LJ^XLFSTR(LN,80)

 +3        WRITE !!

           KILL I,LN

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           IF Y="M"

               GOTO SEL

LIST      ;

 +1        KILL DIR

           WRITE !!?5,"Select a starting TEST NAME "

           READ LRN:DTIME

           IF '$TEST!($EXTRACT(LRN)="^")

               GOTO END

LK        ;

 +1        WRITE !

           SET LRAUTO=0

           IF $LENGTH(LRN)>1

               SET LRN=$EXTRACT(LRN,1,($LENGTH(LRN)-1))

LAB       ;

 +1        SET LREND=""

FOR

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

               IF LRN=""!($GET(LREND))

                   QUIT

               Begin DoDot:1

 +2                SET LRIEN=""

FOR

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

                       IF LRIEN<1!($GET(LREND))

                           QUIT

                       IF '$GET(^(LRIEN))

                           DO CHECK

               End DoDot:1

 +3        IF '$GET(LREND)

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

 +4        GOTO END

 +5        QUIT

CHECK     ;

 +1        IF '$PIECE(^LAB(60,LRIEN,0),";",2)

               QUIT

 +2        KILL DIC

           IF '$DATA(^LAB(60,LRIEN,0))#2!($PIECE($GET(^LAB(60,LRIEN,64)),U,2))!($GET(LREND))

               QUIT

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

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

           IF LRTY=""!(LRTY="N")

               QUIT

 +4        SET X60=LRIEN

           DO SELX

 +5        QUIT

END       ;

 +1        KILL DIRUT,LRAUTO,LRDATA,LREND,LRANS,LRIEN,LRN,LRNLT,LRTY,N,X,X60,Y,Y64,ZTSAVE

 +2        DO END^LR7OU64

 +3        QUIT

SEL       ;

 +1        SET LRAUTO=1

 +2        IF $GET(LREND)

               IF LRAUTO=1

                   GOTO END

 +3        WRITE @IOF

 +4        KILL DIC,DIR,DR,DA,DIE

           SET DIC("A")="You may select any ATOMIC test in LABORATORY TEST FILE: "

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

           SET DIC(0)="AEQZMN"

           SET DIC("S")="I $P(^(0),"";"",2)"

           DO ^DIC

           KILL DIC

           IF Y<1

               GOTO END

 +6        SET LRDATA=$PIECE(Y(0),U)

           SET (LRIEN,X60)=+Y

SELX       LOCK +^LAB(60,LRIEN):2

 +1        IF '$TEST

               WRITE !?4,"Locked by another user"

               IF 'LRAUTO

                   QUIT

               IF LRAUTO

                   GOTO SEL

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

               IF $DATA(^LAM(+$PIECE(^(64),U,2),0))

                   SET Y64=^(0)

                   Begin DoDot:1

 +3                    WRITE !!?5,"Currently linked to [ ",$PIECE(Y64,U)_" ]   "_$PIECE(Y64,U,2),!!

                   End DoDot:1

 +4        WRITE !!,"Now select a RESULT NLT CODE for "_LRDATA,!

 +5        KILL DIC,DIE,DR,DA

 +6        SET DA=LRIEN

           SET (DIC,DIE)="^LAB(60,"

           SET DR=64.1

 +7        DO ^DIE

 +8        LOCK -^LAB(60,LRIEN)

 +9        IF $DATA(Y)

               SET LREND=1

               QUIT

 +10       WRITE !!?3,"IEN: [",DA,"] ",$PIECE(^LAB(60,LRIEN,0),U),"  RESULT NLT CODE: ",$$GET1^DIQ(60,LRIEN_",",64.1,"")

 +11       KILL DA,DIC,DIE,DR

 +12       IF '$GET(LRAUTO)

               QUIT

 +13       KILL DIR

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET LREND=1

           IF $GET(LREND)

               QUIT

 +14       GOTO SEL

 +15      ;

TXT       ;;

 +1       ;;           Linking RESULT NLT CODE methods description

 +2       ;;

 +3       ;;                    ONLY ATOMIC LAB TEST

 +4       ;;      YIELDING A RESULT CAN BE LINKED TO RESULT NLT CODES.

 +5       ;;

 +6       ;;(S) You can use the semi automated method, which will provide a

 +7       ;;alphabetical listing of LABORATORY TEST names. The system will prompt

 +8       ;;you for those tests not already assigned a RESULT NLT CODE.

 +9       ;;Tests with null TYPE or with the type of NEITHER are excluded.

 +10      ;;

 +11      ;;(M) Using the Manual method, you are able to select ANY ATOMIC test

 +12      ;;regardless of the type field in the LABORATORY TEST file,

 +13      ;;and assign it a RESULT NLT CODE. If the test is already linked

 +14      ;;the system will display the code and allow you to change

 +15      ;;the RESULT NLT CODE assigned. This method will allow you to

 +16      ;;change linked LABORATORY TEST to another RESULT NLT CODE.

 +17      ;;END

 +18       QUIT

 +19      ;

LLIST     ;

 +1        KILL DIR

 +2        SET DIR("A")="Would you like a list of Result NLT linked codes"

 +3        SET DIR(0)="S^0:No;1:ALL;2:Linked;3:Unlinked"

 +4        DO ^DIR

 +5        IF $DATA(DIRUT)!(Y=0)

               QUIT

 +6        SET LRANS=Y

 +7        KILL %ZIS

 +8        SET %ZIS="Q"

           DO ^%ZIS

 +9        IF POP

               DO HOME^%ZIS

               QUIT

 +10       IF $DATA(IO("Q"))

               Begin DoDot:1

 +11               NEW ZTDESC,ZTRTN,ZTSAVE

 +12               SET ZTRTN="DQ^LR7OU641"

                   SET ZTSAVE("LRANS")=""

                   SET ZTDESC="List of Result NLT Linked Codes"

 +13               DO ^%ZTLOAD

                   WRITE !,$SELECT($GET(ZTSK):"Task Number "_ZTSK,1:"Failed to Queue Job")

 +14               DO ^%ZISC

               End DoDot:1

               QUIT

 +15      ;

DQ         USE IO

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +1        WRITE !!?5,"Listing of ",$SELECT(LRANS=1:"ALL",LRANS=2:"LINKED",1:"UNLINKED")," Laboratory Test   [ ",$$HTE^XLFDT($HOROLOG)," ] ",!!

 +2        SET LRN=""

FOR

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

               IF LRN=""!($GET(LREND))

                   QUIT

               SET LRIEN=""

               Begin DoDot:1

 +3                FOR

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

                       IF LRIEN<0!($GET(^(LRIEN)))!($GET(LREND))

                           QUIT

                       IF '$DATA(^LAB(60,LRIEN,0))

                           QUIT

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

                       IF LRTY=""

                           QUIT

                       Begin DoDot:2

 +4                        IF LRANS=1

                               DO PRT

                               QUIT

 +5                        IF LRANS=2

                               IF $PIECE($GET(^LAB(60,LRIEN,64)),U,2)

                                   DO PRT

                                   QUIT

 +6                        IF LRANS=3

                               IF '$PIECE($GET(^LAB(60,LRIEN,64)),U,2)

                                   DO PRT

                                   QUIT

                       End DoDot:2

               End DoDot:1

 +7        WRITE !?20,"****  End of Print List  ****",!!!

 +8        IF $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           DO ^%ZISC

           QUIT

PRT       ;

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF $Y>(IOSL-4)

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   IF $DATA(DIRUT)

                       SET LREND=1

                   IF $GET(LREND)

                       QUIT

                   WRITE @IOF

 +2        WRITE !?5,LRN,?45,"[ ",$SELECT(LRTY="B":"BOTH",LRTY="N":"NEITHER",LRTY="O":"OUTPUT",1:"INPUT")," ]",!

 +3        SET LRNLT=$GET(^LAB(60,LRIEN,64))

 +4        IF $DATA(^LAM(+$PIECE(LRNLT,U),0))

               WRITE !,"National VA LAB CODE",?23,$PIECE(^(0),U,2),"  ",$PIECE(^(0),U)

 +5        IF $DATA(^LAM(+$PIECE(LRNLT,U,2),0))

               WRITE !,"Result NLT Code",?23,$PIECE(^(0),U,2),"  ",$PIECE(^(0),U)

 +6        WRITE !

           QUIT

LR7OU641.m