source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OU641.m@ 1250

Last change on this file since 1250 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1LR7OU641 ;SLC/DCM/DALOI/FHS - RESULT NLT LINKING UTILITY SEMI-MANUAL ; 12/3/1997
2 ;;5.2;LAB SERVICE;**153,201,278,280**;Sep 27, 1994
3 ;
4EN ;
564 ;User assigns links between 60 (64.1) and 64 (NLT)
6 K DX S LREND=0 D LLIST S LREND=0
7 I '$O(^LAB(60,"AE",0)) D H 5
8 . W !?5,"You have not yet ran the Semi-automatic Linking of RESULT NLT option",!
9 . W !?20,"[LR70 641-64 AUTO]",!
10 . W !,"IT IS STRONGLY RECOMMENDED YOU RUN THE AUTOMATIC OPTION FIRST",!!
11 W !,$$CJ^XLFSTR("This option will allow you to assign RESULT NLT Code to Atomic Lab Tests.",80)
12 W !,$$CJ^XLFSTR("You must select any WKLD CODE ",80)
13 W !,$$CJ^XLFSTR("Tests with the type of NEITHER or null will be skipped in the Auto Mode.",80)
14 W !,$$CJ^XLFSTR("ONLY ATOMIC LAB TEST YIELDING RESULTS SHOULD BE ASSIGNED RESULT CODES.",80),!!
15 K DIR S DIR("A")="Print list of both NLT and RESULT NLT CODES from LABORATORY TEST file",DIR(0)="Y",DIR("B")="No"
16 D ^DIR K DIR G:$D(DIRUT) END I Y=1 D G:$D(DIRUT)!(Y=0) END G START
17 . D ^LRCAPD K DIR S DIR("A")="Ready to start RESULT NLT CODE linkage procedure ",DIR(0)="Y"
18 . D ^DIR K DIR
19MSG ;
20 W ! K DIR S DIR("A")="Ready to proceed",DIR(0)="Y"
21 D ^DIR K DIR G:$D(DIRUT)!(Y'=1) END
22START W ! K DIR S DIR("A")="Select Linking Method ",DIR(0)="S^M:Manual;S:Semi-Auto",DIR("?")="Linking method description"
23 W !!,$$CJ^XLFSTR(DIR("A"),80)
24 F I=1:1 S LN=$P($T(TXT+I),";;",2) Q:LN="END" S DIR("?",I)=LN W !,$$LJ^XLFSTR(LN,80)
25 W !! K I,LN D ^DIR K DIR G:$D(DIRUT) END G:Y="M" SEL
26LIST ;
27 K DIR W !!?5,"Select a starting TEST NAME " R LRN:DTIME G:'$T!($E(LRN)="^") END
28LK ;
29 W ! S LRAUTO=0 S:$L(LRN)>1 LRN=$E(LRN,1,($L(LRN)-1))
30LAB ;
31 S LREND="" F S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(LREND)) D
32 . S LRIEN="" F S LRIEN=+$O(^LAB(60,"B",LRN,LRIEN)) Q:LRIEN<1!($G(LREND)) D:'$G(^(LRIEN)) CHECK
33 W:'$G(LREND) !!,$$CJ^XLFSTR("End of loop",80),!
34 G END
35 Q
36CHECK ;
37 Q:'$P(^LAB(60,LRIEN,0),";",2)
38 K DIC Q:'$D(^LAB(60,LRIEN,0))#2!($P($G(^LAB(60,LRIEN,64)),U,2))!($G(LREND))
39 S LRDATA=$P(^LAB(60,LRIEN,0),U),LRTY=$P(^(0),U,3) Q:LRTY=""!(LRTY="N")
40 S X60=LRIEN D SELX
41 Q
42END ;
43 K DIRUT,LRAUTO,LRDATA,LREND,LRANS,LRIEN,LRN,LRNLT,LRTY,N,X,X60,Y,Y64,ZTSAVE
44 D END^LR7OU64
45 Q
46SEL ;
47 S LRAUTO=1
48 I $G(LREND),LRAUTO=1 G END
49 W @IOF
50 K DIC,DIR,DR,DA,DIE S DIC("A")="You may select any ATOMIC test in LABORATORY TEST FILE: "
51 S DIC="^LAB(60,",DIC(0)="AEQZMN",DIC("S")="I $P(^(0),"";"",2)" D ^DIC K DIC G:Y<1 END
52 S LRDATA=$P(Y(0),U),(LRIEN,X60)=+Y
53SELX L +^LAB(60,LRIEN):2
54 I '$T W !?4,"Locked by another user" Q:'LRAUTO G:LRAUTO SEL
55 I $P($G(^LAB(60,X60,64)),U,2),$D(^LAM(+$P(^(64),U,2),0)) S Y64=^(0) D
56 . W !!?5,"Currently linked to [ ",$P(Y64,U)_" ] "_$P(Y64,U,2),!!
57 W !!,"Now select a RESULT NLT CODE for "_LRDATA,!
58 K DIC,DIE,DR,DA
59 S DA=LRIEN,(DIC,DIE)="^LAB(60,",DR=64.1
60 D ^DIE
61 L -^LAB(60,LRIEN)
62 I $D(Y) S LREND=1 Q
63 W !!?3,"IEN: [",DA,"] ",$P(^LAB(60,LRIEN,0),U)," RESULT NLT CODE: ",$$GET1^DIQ(60,LRIEN_",",64.1,"")
64 K DA,DIC,DIE,DR
65 Q:'$G(LRAUTO)
66 K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) LREND=1 Q:$G(LREND)
67 G SEL
68 ;
69TXT ;;
70 ;; Linking RESULT NLT CODE methods description
71 ;;
72 ;; ONLY ATOMIC LAB TEST
73 ;; YIELDING A RESULT CAN BE LINKED TO RESULT NLT CODES.
74 ;;
75 ;;(S) You can use the semi automated method, which will provide a
76 ;;alphabetical listing of LABORATORY TEST names. The system will prompt
77 ;;you for those tests not already assigned a RESULT NLT CODE.
78 ;;Tests with null TYPE or with the type of NEITHER are excluded.
79 ;;
80 ;;(M) Using the Manual method, you are able to select ANY ATOMIC test
81 ;;regardless of the type field in the LABORATORY TEST file,
82 ;;and assign it a RESULT NLT CODE. If the test is already linked
83 ;;the system will display the code and allow you to change
84 ;;the RESULT NLT CODE assigned. This method will allow you to
85 ;;change linked LABORATORY TEST to another RESULT NLT CODE.
86 ;;END
87 Q
88 ;
89LLIST ;
90 K DIR
91 S DIR("A")="Would you like a list of Result NLT linked codes"
92 S DIR(0)="S^0:No;1:ALL;2:Linked;3:Unlinked"
93 D ^DIR
94 Q:$D(DIRUT)!(Y=0)
95 S LRANS=Y
96 K %ZIS
97 S %ZIS="Q" D ^%ZIS
98 I POP D HOME^%ZIS Q
99 I $D(IO("Q")) D Q
100 . N ZTDESC,ZTRTN,ZTSAVE
101 . S ZTRTN="DQ^LR7OU641",ZTSAVE("LRANS")="",ZTDESC="List of Result NLT Linked Codes"
102 . D ^%ZTLOAD W !,$S($G(ZTSK):"Task Number "_ZTSK,1:"Failed to Queue Job")
103 . D ^%ZISC
104 ;
105DQ U IO I $D(ZTQUEUED) S ZTREQ="@"
106 W !!?5,"Listing of ",$S(LRANS=1:"ALL",LRANS=2:"LINKED",1:"UNLINKED")," Laboratory Test [ ",$$HTE^XLFDT($H)," ] ",!!
107 S LRN="" F S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(LREND)) S LRIEN="" D
108 . 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
109 . . I LRANS=1 D PRT Q
110 . . I LRANS=2,$P($G(^LAB(60,LRIEN,64)),U,2) D PRT Q
111 . . I LRANS=3,'$P($G(^LAB(60,LRIEN,64)),U,2) D PRT Q
112 W !?20,"**** End of Print List ****",!!!
113 W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
114PRT ;
115 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
116 W !?5,LRN,?45,"[ ",$S(LRTY="B":"BOTH",LRTY="N":"NEITHER",LRTY="O":"OUTPUT",1:"INPUT")," ]",!
117 S LRNLT=$G(^LAB(60,LRIEN,64))
118 I $D(^LAM(+$P(LRNLT,U),0)) W !,"National VA LAB CODE",?23,$P(^(0),U,2)," ",$P(^(0),U)
119 I $D(^LAM(+$P(LRNLT,U,2),0)) W !,"Result NLT Code",?23,$P(^(0),U,2)," ",$P(^(0),U)
120 W ! Q
Note: See TracBrowser for help on using the repository browser.