source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPILK.m@ 1604

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LREPILK ;DALLAS/SED - NLT LINKING UTILITY ; 101098
2 ;;5.2;LAB SERVICE;**132,175**;Sep 27, 1994
3 ;This routine assists the user in linking file 62.02 'ANTIMICROBIAL'
4 ;to file 64 'WRKLOAD'
5 ;
6HD W @IOF,"This option will allow you to link file '62.06 ANTIMICROBIAL "
7 W !,"SUSCEPTIBILITY' file with file '64 WKLD CODE."
8 Q
9EN F D HD K DIR,DIRUT S DIR(0)="S^A:AUTO;M:MANUAL;S:SEMI-AUTO",DIR("??")="LREPILK^D HD^LREPILK" D ^DIR Q:$D(DIRUT) D @Y
10EXIT K DIC,DIE,DR,LRANT,LRANM,LRND,LRNDM,DIR,DIRUT,DIDEL,DA,DUOUT,LRQ,Y,X
11 Q
12A S LRANT=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0 D
13 .I +$G(^LAB(62.06,LRANT,64))>0&($D(^LAM(+$G(^LAB(62.06,LRANT,64)),0))) D LNKED Q
14 .S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRND=$P(^LAB(62.06,LRANT,0),U,4)
15 .S LRNDM=""
16 .I +LRND>0,$D(^DD(63.3,LRND,0)) S LRNDM=$P(^DD(63.3,LRND,0),U,1)
17 .S DIC=64,DIC(0)="XMO",X=LRANM D ^DIC
18 .I +Y<0&(LRNDM'="") S DIC=64,DIC(0)="XMO",X=LRNDM D ^DIC
19 .W:+Y>0 !,LRANM,?30,"<----Linked---->",?50,$P(Y,U,2)
20 .W:+Y'>0 !,LRANM,?30,"<----Not Linked---->",?50,"No Match Found"
21 .Q:+Y'>0
22 .K DIC,DD,DR,DA,DIE
23 .S DIE=62.06,DA=LRANT,DR="64////"_+Y D ^DIE
24 Q
25LNKED ;DISPLAY LINKED INFO
26 S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRNLT=+$G(^LAB(62.06,LRANT,64))
27 Q:'$D(^LAM(LRNLT,0))
28 W !,LRANM,?30,"<----Linked---->",?50,$P(^LAM(LRNLT,0),U)
29 Q
30M ;MANUALLY SELECTION AND ENTRY
31 F K DIC S DIC="62.06",DIC(0)="AEQM" D ^DIC Q:+Y<0!($D(DUOUT)) S:+Y>0 LRANT=+Y D SET
32 Q
33SET K DIC,DD,DR,DA,DIE
34 S DIE=62.06,DA=LRANT,DR="64//" D ^DIE
35 Q
36S S (LRQ,LRANT)=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0!(LRQ) D
37 .Q:+$G(^LAB(62.06,LRANT,64))>0
38 .S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRND=$P(^LAB(62.06,LRANT,0),U,4)
39 .S LRNDM=""
40 .I +LRND>0,$D(^DD(63.3,LRND,0)) S LRNDM=$P(^DD(63.3,LRND,0),U,1)
41 .W @IOF,!,LRANM,?15,LRNDM
42 .D SET
43 .S DIR(0)="YA",DIR("A")="Continue ",DIR("B")="YES" D ^DIR S:Y'="1" LRQ=1
44 Q
45REM ;REMOVE ENTRIES
46 S LRANT=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0 K ^LAB(62.06,LRANT,64)
47 Q
Note: See TracBrowser for help on using the repository browser.