source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OU5.m@ 1042

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

initial load of WorldVistAEHR
File size: 5.5 KB
RevLine 
[613]1LR7OU5 ;DALOI/DCM/FHS-NLT LINKING UTILITY SEMI-MANUAL ; 2/23/07 6:53am
2 ;;5.2;LAB SERVICE;**127,201,272,334**;Sep 27, 1994;Build 12
3 ; Reference to ^%ZIS supported by IA #10086
4 ; Reference to ^%ZISC supported by IA #10089
5 ; Reference to ^%ZTLOAD supported by IA #10063
6 ; Reference to ^DIC supported by IA #10007
7 ; Reference to ^DIR supported by IA #10026
8 ; Reference to $$HTE^XLFDT supported by IA #10103
9 ; Reference to $$CJ^XLFDT supported by IA #10104
10 ; Reference to $$LJ^XLFDT supported by IA #10104
11EN ;
1264 ;User assigns links between 60 and 64 (NLT)
13 D LLIST G:$G(LREND) END
14 I '$O(^LAB(60,"AD",0)) D H 5
15 . W !?5,"You have not yet ran the 'Semi-automatic Linking of file 60 to 64' option",!
16 . W !?20,"[LR70 60-64 AUTO]",!
17 . W !,"IT IS STRONGLY RECOMMENDED YOU RUN THE AUTOMATIC OPTION FIRST",!!
18 W !,$$CJ^XLFSTR("This option will allow you to make links between file 64 (NLT) and file 60.",80)
19 W !,$$CJ^XLFSTR("You may select ANY NLT code to create ",80)
20 W !,$$CJ^XLFSTR("a linkage of entries between these two files. ",80)
21 W !,$$CJ^XLFSTR("Tests with the type of NEITHER or null will be skipped in the Auto Mode.",80)
22 W !,$$CJ^XLFSTR("ONLY ORDERABLE LAB TEST NEED TO BE LINKED TO WKLD CODES.",80),!
23 K DIR S DIR("A")="Would you like a list of WKLD CODES from LABORATORY TEST file",DIR(0)="Y",DIR("B")="No"
24 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 START
25 . D ^LRCAPD K DIR S DIR("A")="Ready to start linkage procedure ",DIR(0)="Y"
26 . D ^DIR
27MSG ;
28 W ! K DIR S DIR("A")="Ready to proceed",DIR(0)="Y"
29 D ^DIR G:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(Y'=1) END
30START W ! K DIR S DIR("A")="Select Linking Method ",DIR(0)="S^M:Manual;S:Semi-Auto",DIR("?")="Linking method description"
31 W !!,$$CJ^XLFSTR(DIR("A"),80)
32 F I=1:1 S LN=$P($T(TXT+I),";;",2) Q:LN="END" S DIR("?",I)=LN W !,$$LJ^XLFSTR(LN,80)
33 W !! K LN D ^DIR K DIR G:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) END G:Y="M" SEL
34LIST ;Print LOINC Code Status
35 K DIR W !!?5,"Select a starting TEST NAME " R LRN:DTIME G:'$T!($E(LRN)=U) END
36LK ;
37 W ! S AUTO=0 S:$L(LRN)>1 LRN=$E(LRN,1,($L(LRN)-1))
38LAB ;
39 S END="" F S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(END)) D
40 . S LRIEN="" F S LRIEN=+$O(^LAB(60,"B",LRN,LRIEN)) Q:LRIEN<1!($G(END)) I '$G(^(LRIEN)) D CHECK
41 W:'$G(END) !!,$$CJ^XLFSTR("End of loop",80),!
42 G END
43 Q
44CHECK ;
45 K DIC Q:'($D(^LAB(60,LRIEN,0))#2)!($G(^LAB(60,LRIEN,64)))!($G(END))
46 S LRDATA=$P(^LAB(60,LRIEN,0),U),LRTY=$P(^(0),U,3) Q:LRTY=""!(LRTY="N")
47 D I $G(LRMIEN) S:($D(^LAM(LRMIEN,0))#2) Y=LRMIEN,Y(0)=^(0),LRCODE=$P(Y(0),U,2),LRMNAME=$P(Y(0),U) G OK
48 . K LRMIEN D 91^LR7OU4
49 . Q:'$G(LRMIEN)!'($D(^LAM(+$G(LRMIEN),0))#2) S LRCODE=$P($P(^(0),U,2),".",1)_".0000 " I 'LRCODE W !,"Database is corrupted for WKLD CODE ",LRCODE S LRMIEN="" Q
50 . S LRMIEN=$O(^LAM("C",LRCODE,0)) Q:('LRMIEN)!'($D(^LAM(LRMIEN,0))#2)
51 K DIC S DIC="^LAM(",DIC(0)="AQEZNM"
52 W !,$$CJ^XLFSTR("Select NLT code to be linked with LAB TEST",80),!,$$CJ^XLFSTR(LRDATA,80),!
53 D ^DIC S:$E(X)=U END=1 Q:$G(END)!(Y<1)
54 S LRMIEN=+Y,LRMNAME=$P(Y(0),U),LRCODE=$P(Y(0),U,2)
55OK I '($D(^LAM(LRMIEN,0))#2) W !!,"Database is corrupted for IEN ",LRMIEN Q
56 W !!,"60 = ",LRDATA,!,"64 = ",LRMNAME_" "_LRCODE
57 D LINK^LR7OU4(LRIEN,LRMIEN,AUTO)
58 Q
59END ;
60 K LREND,LRANS,LRN,LRTY,ZTSAVE D END^LR7OU4
61 K LINKED,LRMNAME,LRNLT,POP,ZTRTN,ZTDESC,ZTQUEUED
62 K DIROUT,DIRUT,DTOUT,DUOUT,ZTDESC,X1,X60,X64,Y64 Q
63SEL ;
64 S AUTO=0
65 K DIC,DIR S DIC("A")="You may select any test in LABORATORY TEST FILE: "
66 S DIC="^LAB(60,",DIC(0)="AEQZMN" D ^DIC G:Y<1 END
67 S LRDATA=$P(Y(0),U),(LRIEN,X60)=+Y
68 I $G(^LAB(60,X60,64)),$D(^LAM(+^(64),0)) S Y64=^(0) D
69 . W !!?5,"Currently linked to [ ",$P(Y64,U)_" ] "_$P(Y64,U,2),!!
70 W !!,"Now select ANY WKLD CODE for "_LRDATA,!!
71 K DIC S DIC="^LAM(",DIC(0)="AEQZNM",DIC("A")="WKLD CODE: "
72 D ^DIC G:Y<1 SEL S (LRMIEN,X64)=+Y,LRMNAME=$P(Y(0),U),LRCODE=$P(Y(0),U,2)
73 D OK G SEL
74TXT ;;
75 ;; Linking options description
76 ;;ONLY ORDERABLE LAB TEST NEED TO BE LINKED TO WKLD CODES.
77 ;;
78 ;;(S) You can use the semi automated method, which will provide a
79 ;;alphabetical listing of LABORATORY TEST names. The system will prompt
80 ;;you for those tests not already assigned a WKLD CODE.
81 ;;Tests with null TYPE or with the type of NEITHER are excluded.
82 ;;
83 ;;(M) Using the Manual method, you are able to select ANY test
84 ;;regardless of the type field in the LABORATORY TEST file,
85 ;;and assign it a WKLD CODE. If the test is already linked
86 ;;the system will display the code and allow you to change
87 ;;the WKLD CODE assigned. This method will allow you to
88 ;;change linked LABORATORY TEST to another WKLD CODE.
89 ;;END
90 Q
91LLIST ;
92 W !?5,"Would you like a list of Laboratory Tests"
93 K DIR S DIR(0)="S^0:No;1:ALL;2:Linked;3:Unlinked" D ^DIR
94 Q:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))!(Y=0)
95 S LRANS=Y
96 K %ZIS S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) K ZTSAVE S ZTRTN="DQ^LR7OU5",ZTSAVE("LRANS")="",ZTDESC="LAB TEST LIST" D ^%ZTLOAD,^%ZISC Q
97DQ U IO I $D(ZTQUEUED) S ZTREQ="@"
98 W !!?5,"Listing of ",$S(LRANS=1:"ALL",LRANS=2:"LINKED",1:"UNLINKED")," Laboratory Test [ ",$$HTE^XLFDT($H)," ] ",!!
99 S LRN="" F S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(LREND)) S LRIEN="" D
100 . 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
101 . . I LRANS=1 D PRT Q
102 . . I LRANS=2,$G(^LAB(60,LRIEN,64)) D PRT Q
103 . . I LRANS=3,'$G(^LAB(60,LRIEN,64)) D PRT Q
104 W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
105PRT ;
106 W !?5,LRN,?45,$S(LRTY="B":"BOTH",LRTY="N":"NEITHER",LRTY="O":"OUTPUT",1:"INPUT"),!
107 S LRNLT=$G(^LAB(60,LRIEN,64)) I LRNLT,$D(^LAM(LRNLT,0)) W $P(^(0),U,2),?15,$P(^(0),U)
108 W ! Q
Note: See TracBrowser for help on using the repository browser.