LREPILK ;DALLAS/SED - NLT LINKING UTILITY ; 101098
;;5.2;LAB SERVICE;**132,175**;Sep 27, 1994
;This routine assists the user in linking file 62.02 'ANTIMICROBIAL'
;to file 64 'WRKLOAD'
;
HD W @IOF,"This option will allow you to link file '62.06 ANTIMICROBIAL "
W !,"SUSCEPTIBILITY' file with file '64 WKLD CODE."
Q
EN 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
EXIT K DIC,DIE,DR,LRANT,LRANM,LRND,LRNDM,DIR,DIRUT,DIDEL,DA,DUOUT,LRQ,Y,X
Q
A S LRANT=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0 D
.I +$G(^LAB(62.06,LRANT,64))>0&($D(^LAM(+$G(^LAB(62.06,LRANT,64)),0))) D LNKED Q
.S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRND=$P(^LAB(62.06,LRANT,0),U,4)
.S LRNDM=""
.I +LRND>0,$D(^DD(63.3,LRND,0)) S LRNDM=$P(^DD(63.3,LRND,0),U,1)
.S DIC=64,DIC(0)="XMO",X=LRANM D ^DIC
.I +Y<0&(LRNDM'="") S DIC=64,DIC(0)="XMO",X=LRNDM D ^DIC
.W:+Y>0 !,LRANM,?30,"<----Linked---->",?50,$P(Y,U,2)
.W:+Y'>0 !,LRANM,?30,"<----Not Linked---->",?50,"No Match Found"
.Q:+Y'>0
.K DIC,DD,DR,DA,DIE
.S DIE=62.06,DA=LRANT,DR="64////"_+Y D ^DIE
Q
LNKED ;DISPLAY LINKED INFO
S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRNLT=+$G(^LAB(62.06,LRANT,64))
Q:'$D(^LAM(LRNLT,0))
W !,LRANM,?30,"<----Linked---->",?50,$P(^LAM(LRNLT,0),U)
Q
M ;MANUALLY SELECTION AND ENTRY
F K DIC S DIC="62.06",DIC(0)="AEQM" D ^DIC Q:+Y<0!($D(DUOUT)) S:+Y>0 LRANT=+Y D SET
Q
SET K DIC,DD,DR,DA,DIE
S DIE=62.06,DA=LRANT,DR="64//" D ^DIE
Q
S S (LRQ,LRANT)=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0!(LRQ) D
.Q:+$G(^LAB(62.06,LRANT,64))>0
.S LRANM=$P(^LAB(62.06,LRANT,0),U,1),LRND=$P(^LAB(62.06,LRANT,0),U,4)
.S LRNDM=""
.I +LRND>0,$D(^DD(63.3,LRND,0)) S LRNDM=$P(^DD(63.3,LRND,0),U,1)
.W @IOF,!,LRANM,?15,LRNDM
.D SET
.S DIR(0)="YA",DIR("A")="Continue ",DIR("B")="YES" D ^DIR S:Y'="1" LRQ=1
Q
REM ;REMOVE ENTRIES
S LRANT=0 F S LRANT=$O(^LAB(62.06,LRANT)) Q:+LRANT'>0 K ^LAB(62.06,LRANT,64)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPILK 1990 printed Oct 16, 2024@18:15:04 Page 2
LREPILK ;DALLAS/SED - NLT LINKING UTILITY ; 101098
+1 ;;5.2;LAB SERVICE;**132,175**;Sep 27, 1994
+2 ;This routine assists the user in linking file 62.02 'ANTIMICROBIAL'
+3 ;to file 64 'WRKLOAD'
+4 ;
HD WRITE @IOF,"This option will allow you to link file '62.06 ANTIMICROBIAL "
+1 WRITE !,"SUSCEPTIBILITY' file with file '64 WKLD CODE."
+2 QUIT
EN FOR
DO HD
KILL DIR,DIRUT
SET DIR(0)="S^A:AUTO;M:MANUAL;S:SEMI-AUTO"
SET DIR("??")="LREPILK^D HD^LREPILK"
DO ^DIR
if $DATA(DIRUT)
QUIT
DO @Y
EXIT KILL DIC,DIE,DR,LRANT,LRANM,LRND,LRNDM,DIR,DIRUT,DIDEL,DA,DUOUT,LRQ,Y,X
+1 QUIT
A SET LRANT=0
FOR
SET LRANT=$ORDER(^LAB(62.06,LRANT))
if +LRANT'>0
QUIT
Begin DoDot:1
+1 IF +$GET(^LAB(62.06,LRANT,64))>0&($DATA(^LAM(+$GET(^LAB(62.06,LRANT,64)),0)))
DO LNKED
QUIT
+2 SET LRANM=$PIECE(^LAB(62.06,LRANT,0),U,1)
SET LRND=$PIECE(^LAB(62.06,LRANT,0),U,4)
+3 SET LRNDM=""
+4 IF +LRND>0
IF $DATA(^DD(63.3,LRND,0))
SET LRNDM=$PIECE(^DD(63.3,LRND,0),U,1)
+5 SET DIC=64
SET DIC(0)="XMO"
SET X=LRANM
DO ^DIC
+6 IF +Y<0&(LRNDM'="")
SET DIC=64
SET DIC(0)="XMO"
SET X=LRNDM
DO ^DIC
+7 if +Y>0
WRITE !,LRANM,?30,"<----Linked---->",?50,$PIECE(Y,U,2)
+8 if +Y'>0
WRITE !,LRANM,?30,"<----Not Linked---->",?50,"No Match Found"
+9 if +Y'>0
QUIT
+10 KILL DIC,DD,DR,DA,DIE
+11 SET DIE=62.06
SET DA=LRANT
SET DR="64////"_+Y
DO ^DIE
End DoDot:1
+12 QUIT
LNKED ;DISPLAY LINKED INFO
+1 SET LRANM=$PIECE(^LAB(62.06,LRANT,0),U,1)
SET LRNLT=+$GET(^LAB(62.06,LRANT,64))
+2 if '$DATA(^LAM(LRNLT,0))
QUIT
+3 WRITE !,LRANM,?30,"<----Linked---->",?50,$PIECE(^LAM(LRNLT,0),U)
+4 QUIT
M ;MANUALLY SELECTION AND ENTRY
+1 FOR
KILL DIC
SET DIC="62.06"
SET DIC(0)="AEQM"
DO ^DIC
if +Y<0!($DATA(DUOUT))
QUIT
if +Y>0
SET LRANT=+Y
DO SET
+2 QUIT
SET KILL DIC,DD,DR,DA,DIE
+1 SET DIE=62.06
SET DA=LRANT
SET DR="64//"
DO ^DIE
+2 QUIT
S SET (LRQ,LRANT)=0
FOR
SET LRANT=$ORDER(^LAB(62.06,LRANT))
if +LRANT'>0!(LRQ)
QUIT
Begin DoDot:1
+1 if +$GET(^LAB(62.06,LRANT,64))>0
QUIT
+2 SET LRANM=$PIECE(^LAB(62.06,LRANT,0),U,1)
SET LRND=$PIECE(^LAB(62.06,LRANT,0),U,4)
+3 SET LRNDM=""
+4 IF +LRND>0
IF $DATA(^DD(63.3,LRND,0))
SET LRNDM=$PIECE(^DD(63.3,LRND,0),U,1)
+5 WRITE @IOF,!,LRANM,?15,LRNDM
+6 DO SET
+7 SET DIR(0)="YA"
SET DIR("A")="Continue "
SET DIR("B")="YES"
DO ^DIR
if Y'="1"
SET LRQ=1
End DoDot:1
+8 QUIT
REM ;REMOVE ENTRIES
+1 SET LRANT=0
FOR
SET LRANT=$ORDER(^LAB(62.06,LRANT))
if +LRANT'>0
QUIT
KILL ^LAB(62.06,LRANT,64)
+2 QUIT
