source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OU64.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1LR7OU64 ;SLC/DCM/FHS/DALISC - RESULT CODE NLT LINKING UTILITY AUTO ; 12/3/1997
2 ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
3EN ;
4 ;Find matches between file 64 and 60
5 D MSG
6LIST ;
7 K DIR S DIR("A")="Would you like a list of RESULT NLT CODES from LABORATORY TEST file",DIR(0)="Y",DIR("B")="No"
8 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
9 . D LST K DIR S DIR("A")="Ready to start linkage procedure ",DIR(0)="Y"
10 . D ^DIR
11 W ! K DIR S DIR("A")="Ready to proceed",DIR(0)="Y"
12 D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))!(Y'=1) END
13LK W !!,$$CJ^XLFSTR("Do you want to automatically link entries when there is an exact match",80)
14 W !,$$CJ^XLFSTR("on the NAME in both files",80) S %=2 D YN^DICN G:%=-1 END
15 I %=0 W !!,$$CJ^XLFSTR("Answer YES to automatically link the entries, or NO to be prompted for each",80) G LK
16 S AUTO=$S(%=1:1,1:0)
17LAB ;
18 W:$G(AUTO) !?5,"Press Return to Stop Auto Update",!
19 S (END,LRN)="" F S LRN=$O(^LAB(60,"B",LRN)) Q:LRN=""!($G(END)) D
20 . S LRIEN="" F S LRIEN=+$O(^LAB(60,"B",LRN,LRIEN)) Q:LRIEN<1!($G(END)) I '$G(^(LRIEN)) D CHECK
21 W:'$G(END) !!,$$CJ^XLFSTR("End of loop",80),!
22 G END
23 Q
24CHECK ;
25 S LRMIEN=0
26 Q:'$D(^LAB(60,LRIEN,0))#2!('$P(^(0),";",2))!($P($G(^LAB(60,LRIEN,64)),U,2))!($G(END))
27 S LRDATA=$P(^LAB(60,LRIEN,0),U),LRTY=$P(^(0),U,3) Q:LRTY=""!(LRTY="N")
28 S LRNU=$$UP^XLFSTR(LRN),X=+$O(^LAM("D",LRNU,0)) I $D(^LAM(X,0)),^(0)'["~" S LRMIEN=X
29 D:'LRMIEN 64 Q:'LRMIEN!($G(END))
30 Q:'$D(^LAM(LRMIEN,0))#2 S LRCODE=$P(^(0),U,2) Q:'LRCODE!($D(^LAB(60,"AE",LRCODE)))
31 Q:'$D(^LAM(LRMIEN,0)) S LRMNAME=$P(^(0),U)
32 W !!,"60 = ",LRDATA,!,"64 = ",LRMNAME_" "_LRCODE
33 D LINK(LRIEN,LRMIEN,AUTO)
34 Q
3564 ;Look for NATIONAL VA LAB CODE
36 S LRMIEN=0,I=+$P($G(^LAB(60,LRIEN,64)),U,2) I $D(^LAM(I,0)),^(0)'["~" S LRMIEN=I
37 Q:'LRMIEN
38 W !,$C(7),?5,"Did not find a exact name match for Lab Test "_LRDATA,!
39 K DIR
40 W !," Want to use the ["_$P(^LAM(LRMIEN,0),U)_"] NATIONAL VA LAB CODE instead?"
41 K DIR S DIR(0)="Y" D ^DIR S:Y'=1 LRMIEN=0 Q
42 Q
43LINK(X60,X641,DOIT) ;Link the 2 files
44 S LRDATA="`"_X60 I DOIT S %=1 G L2
45L1 W !?5,"Link the two entries" S %=2 D YN^DICN Q:%=2 I %=-1 S END=1 Q
46 I $G(DTOUT) S END=1 Q
47 I %=0 W !,"Enter Yes to link the entries, No to leave it alone." G L1
48L2 K DIE,DA,DR,DIC S DIE="^LAB(60,",DA=X60,DR="64.1///`"_X641,DLAYGO=60 D ^DIE K DLAYGO
49 I $P($G(^LAB(60,X60,64)),U,2) W !?32,"o----LINKED----o",! D Q
50 . R X:1 I $T W !?20,"User terminated update",!,$C(7) S END=1
51 W !!?15,"***************** NOT LINKED ***************",!
52 W !!?5,"Press Return to continue" R X:DTIME S:$G(DTOUT)!($E(X)=U) END=1
53 Q
54END ;
55 Q:$G(LRDBUG)
56 K %,AUTO,DA,DIC,DIE,DIR,DOIT,DR,END,LRDATA,LRIEN,LRMIEN,LRN,LRNU
57 K LRSUF,LRTY,X,X60,X64,Y,LRMNAME,D1,D0,DLAYGO,I,LRCODE,END
58 K FLG,XXX,ZZ,ZZ1,X,Y,Y64,DLAYGO,DX,S
59 Q
60LST ;
61 K ^TMP("LR",$J),DIC I $O(^LAB(60,"AE",0))="" W !,"Nothing in X-Ref to Print.",!! Q
62 W !!,$$CJ^XLFSTR("I will produce a list of ",80)
63 W !,$$CJ^XLFSTR("NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!
64 K %ZIS S %ZIS="QN",%ZIS("A")="Printer Name " D ^%ZIS G:POP CLEAN
65 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
66DQ K ^TMP("LR",$J),DX S:$D(ZTQUEUED) ZTREQ="@"
67 W !!,$$CJ^XLFSTR("List of NATIONAL VA Code / Result NLT codes from LABORATORY TEST file",80),!!
68 W ?6,$$NOW^XLFDT,!
69 S LRNLT="" F S LRNLT=$O(^LAB(60,"AE",LRNLT)) Q:LRNLT="" D
70 . S LRLAB=0 F S LRLAB=$O(^LAB(60,"AE",LRNLT,LRLAB)) Q:LRLAB<1 D
71 . . S ^TMP("LR",$J,$P(^LAB(60,LRLAB,0),U),LRNLT)=LRLAB
72 S DIC="^LAB(60,"
73 S NODE="^TMP(""LR"","_$J_")" F S NODE=$Q(@NODE) Q:$QS(NODE,2)'=$J D
74 . S DA=@NODE,DR=64 W !,"Test Name: ",$P(^LAB(60,DA,0),U)
75 . D EN^LRDIQ S:$E(IOST,1,2)="P-" S=0
76CLEAN K DIC,DA,NODE,LRNLT,LRLAB,DR,DX,S,^TMP("LR",$J)
77 Q
78MSG W !,$$CJ^XLFSTR("This option will Auto Link NLT RESULT CODE to Laboratory test file (#60).",80)
79 W !,$$CJ^XLFSTR("NLT RESULT CODE is used by the LEDI software to identify",80)
80 W !,$$CJ^XLFSTR("test results returned by Host Laboratories.",80)
81 W !,$$CJ^XLFSTR("ONLY GENERIC NLT CODES CAN BE LINKED TO LAB TEST ",80),!!
82 W !,$$CJ^XLFSTR("Only ATOMIC lab tests can have an NLT RESUTL CODE.",80),!
83 Q
Note: See TracBrowser for help on using the repository browser.