LR7OU641 ;SLC/DCM/DALOI/FHS - RESULT NLT LINKING UTILITY SEMI-MANUAL ; 12/3/1997
;;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
Q
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
Q
END ;
K DIRUT,LRAUTO,LRDATA,LREND,LRANS,LRIEN,LRN,LRNLT,LRTY,N,X,X60,Y,Y64,ZTSAVE
D END^LR7OU64
Q
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
Q
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OU641 5413 printed Sep 23, 2025@19:41:33 Page 2
LR7OU641 ;SLC/DCM/DALOI/FHS - RESULT NLT LINKING UTILITY SEMI-MANUAL ; 12/3/1997
+1 ;;5.2;LAB SERVICE;**153,201,278,280**;Sep 27, 1994
+2 ;
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
