- LREPILK ;DALLAS/SED - NLT LINKING UTILITY ; 101098
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;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
- LREPILK ;DALLAS/SED - NLT LINKING UTILITY ; 101098
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +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 ;
- 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
