Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VCMI

LA7VCMI.m

Go to the documentation of this file. 
  1. LA7VCMI ;IHS/CMI/MAW - Micro Filing Pre LEDI IV ; 22-Oct-2013 09:22 ; MAW
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**1033**;NOV 01, 1997
  1.  ;
  1.  ;
  1.  ;borrowed and modified code from david hoak
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**41**;Sep 27, 1994
  1.  ;
  1.  ;-->P.R.O.T.O.T.Y.P.E.--P.R.O.T.O.T.Y.P.E--P.R.O.T.O.T.Y.P.E
  1.  ;
  1.  ;-------------------------------> MICROSCAN->OBX|1|ST||1|150||||||F
  1.  ;                      /\
  1.  ;---------------------------ORGANISM--------------------|
  1.  ;
  1.  ;---^LAHM(62.49,61,150,11,0)=OBR|2||^ANTIBIOTIC MIC^VANLT||||19861210083
  1.  ;--- |||||||||^^BLOOD|||||||||||87993.0000^1
  1.  ;
  1. EPI      ;---^LAHM(62.49,61,150,13,0) = OBX|1|ST|81812.0000^Neomycin^VANLT^18^NEO
  1.  ;---MYCN^VA62.06|||||R
  1.  ;
  1.  ;
  1.  ;--> CONTINUE DOWN LAHM GLOBAL
  1.  ;
  1. MI ;
  1.  ; Don't do anything, for now.
  1.  ;Q
  1.  ;
  1.  ; I $G(^LAHM(62.49,LA76249,0))["IM-VITEK" D MI^LA7ZV3 QUIT
  1.  K LRISOX
  1.  ;QUIT
  1. OBX      ;
  1.  ;I $G(LA7AN)'>0 D ^AGNQBLOD ;BLOOD CULTURE ACCN AREA
  1.  ;I $L(LA7AN)=8 S LA7AN=+$E(LA7AN,2,8)/1 D BC^AGNQBLOD
  1.  ;
  1.  I $G(LRMIFLAG)=LA7OBR S LA7QUIT=1 D END QUIT
  1.  ;--> Don't pay for the same realestate twice. gsp
  1.  K ^TMP("LRISO"),^TMP("LRORG")
  1.  ;
  1.  ;ihs/cmi/maw 03/08/2013 added for MU and LEDI III
  1.  S LRMIFLAG=LA7OBR
  1.  S LRMIEN=LA762495
  1.  S LA7OBX=$G(LA7SEG(0))
  1.  Q:$G(LA7OBX)=""
  1.  D BUGS
  1.  D CH1
  1.  Q
  1.  ;
  1. BACK     ;
  1.  F  S LA762495=$O(^LAHM(62.49,LA76249,150,LA762495)) Q:'LA762495  S LA7OBX=^LAHM(62.49,LA76249,150,LA762495,0) D CHOBR Q:$E(LA7OBX,1,3)'="OBX"  D
  1.  .  ;
  1.  .  S LRMIFLAG=LA7OBR
  1.  .  ;-->MICROSCAN data inovations  OBX|1|ST|DRUG|ORGANISM|MIC|UNITS|||||F
  1.  .  S LRMIEN=LA762495
  1.  .  D BUGS ;I '$G(LRORGNM) D CREATE^LA7LOG(52) ;-->NO ORG
  1.  .  ;D DRUGS
  1.  ;
  1. CH1      I $E($G(LA7OBX),1,3)="OBR" G BACK
  1.  K LA7CNT D END
  1.  QUIT
  1. CHOBR    ;
  1.  ;ZW LRISOX
  1.  Q:$E(LA7OBX,1,3)'="OBR"
  1.  I LA7OBX["IM-MISCN" S LRISOX=$P(LA7OBX,U,2)
  1.  QUIT
  1.  ;
  1.  ;
  1. BUGS     ;
  1.  ;
  1.  ; ZW LA7OBX
  1.  ;  VITEK
  1.  ; I $G(LRORGNUM) G DRUG
  1.  ; ***
  1.  ; I +$P(LA7OBX,LA7FS,5) G DRUG
  1.  ; LAHM(62.49,1525185,150,5,0) = OBX|1|ST|ISO1||1||||||F
  1.  I LA7OBX["ISO" S LRISO=+$P(LA7OBX,"ISO",2) D  QUIT
  1.  .  S LRORG=+$P(LA7OBX,LA7FS,6)
  1.  .  I '$G(LRISOX) S LRISOX=1
  1.  .  E  S LRISOX=LRISOX+1
  1.  .  S ^TMP("LRISO",$J,LRISOX,LRORG,LRISO)=""
  1.  ; Look in auto inst 62.4 then Get the ien for 61.2
  1.  ;S LRORG=$P($P($G(LA7OBX),LA7FS,5),LA7CS)  ;ihs/cmi/maw 03/08/2013 for MU orig line
  1.  ;ihs/cmi/maw MU2 below code for filing MICRO
  1.  N LA7MRES,LA7MUNIT,LA7MABN,LA7MRS,LA7MRSDT,LA7MPO
  1.  S (LA7MRES,LRORG)=$P($P($G(LA7OBX),LA7FS,6),LA7CS)  ;ihs/cmi/maw 03/08/2013 for MU
  1.  S LA7MUNIT=$P($G(LA7OBX),LA7FS,7)
  1.  I LA7MUNIT]"" S LA7MUNIT=$TR($$TRIM^XLFSTR(LA7MUNIT,"LR"," "),"^","~")
  1.  S LA7MABN=$P($G(LA7OBX),LA7FS,9)
  1.  S LA7MRS=$P($G(LA7OBX),LA7FS,12)
  1.  S LA7MRSDT=$$HL7TFM^XLFDT($$P^LA7VHLU(.LA7SEG,15,LA7FS),"L")
  1.  S LA7MPO=$P($P($G(LA7OBX),LA7FS,24),LA7CS,10)
  1.  S LA7MPO=$$RPTFAC(LA7MPO,LA7SFAC,LA7CS)
  1.  S LRISO=$P(LA7OBX,LA7FS,5)       ; ihs/cmi/maw 03/08/2013 for MU
  1.  I $P(LA7OBX,LA7FS,3)="SN" D  Q   ; ihs/cmi/maw MU2 these are drugs so dont worry about the org here
  1.  . ;S LA7MRES=$P($P($G(LA7OBX),LA7FS,6),LA7CS,2)
  1.  . S LA7MRES=$TR($P($G(LA7OBX),LA7FS,6),LA7CS,"")
  1.  . S LRISO=LA7MPN  ;this is the parent node in OBR
  1.  . D DRUGS
  1.  ;ihs/cmi/maw MU2 end of mods
  1.  I +LRORG>0 S LRORGNUM=$O(^LAB(62.4,LA7624,7,1,1,"C",LRORG,0)) D
  1.  .  Q:'LRORGNUM  ;62.4,3,7,1,1=ORGS 62.4,3,7,1,2=DRUGS
  1.  .  ;
  1.  .  S LRORGNUM=+$G(^LAB(62.4,LA7624,7,1,1,LRORGNUM,0)) D
  1.  ..  I LRORGNUM S LRORGNM=$P($G(^LAB(61.2,LRORGNUM,0)),U)
  1.  N LA7VRS
  1.  S LA7VRS=$P(LA7OBX,LA7FS,12)  ;result status
  1.  D FILE Q     ; ihs/cmi/maw 03/08/2013 for MU
  1.  I +$G(LRORGNUM)>0 G MSCAN QUIT
  1.  ;
  1. BU1      Q:$G(LRORG)=""  S LRORGNUM=$O(^LAB(61.39,1,1,"B",LRORG,0)) D
  1.  .  Q:'LRORGNUM
  1.  .  I LRORGNUM S LRORGNUM=$G(^LAB(61.39,1,1,LRORGNUM,1)) D
  1.  ..  I LRORGNUM S LRORGNM=$P($G(^LAB(61.2,LRORGNUM,0)),U)
  1.  ;I $D(^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)) D
  1.  ; .  ;***
  1.  ; .  ;S LRISO=LRISO+1 S ^TMP("LRISO",$J,LRISO)=""
  1.  ;***
  1.  ;I LRISO>1 Q:LRORGNUM=+$G(^LAH(LA7LWL,1,LA7ISQN,3,LRISO-1,0))
  1. MSCAN    ;
  1.  ;  The microscan sends a number for the organism.
  1.  ;  1 of two possible conditions may exist for the Microscan
  1.  ;  1 the OBX is an ISOn or a DRUG
  1.  ;I '$G(LRISO) S LRISO=$O(^TMP("LRISO",$J,0))
  1.  ;I '$G(LRISO) S LRISO=1
  1.  ;I LRORG S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=$G(LRORG)_U_U D
  1.  ; .  S ^TMP("LRISO",$J,LRISO,LRORG)=""
  1.  ; .  S ^TMP("LRORG",$J,LRORG,LRISO)=""
  1.  ;
  1.  ;Q:+$G(LRORGNUM)>0  ; --This segment has an org in 4th piece
  1.  ;
  1.  Q:LA7OBX["ISO"
  1. DRUG     ; -->VITEK
  1.  ;
  1.  Q:'+$P(LA7OBX,LA7FS,5)
  1.  ;
  1.  ;
  1. SETISO   ;I '$O(^TMP("LRISO",$J,LRISO)) S LRIS0=0 D
  1.  ; . F  S LRISO=$O(^TMP("LRISO",$J,LRISO)) Q:+LRISO
  1.  ;
  1.  S LRORG=$P(LA7OBX,LA7FS,5)
  1.  ;S LRISO=$O(^TMP("LRORG",$J,LRORG,0))
  1.  ;
  1.  ;
  1.  ;
  1.  I $P(LA7OBX,LA7FS,5) I LRORG'=$P($P($G(LA7OBX),LA7FS,5),LA7CS) S LRORG=$P($P($G(LA7OBX),LA7FS,5),LA7CS) I $D(LRORG) G BU1
  1.  ;
  1.  ;I LRISO>1 I LRORGNUM=+$G(^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)) D  QUIT
  1.  ; . K ^LAH(LA7LWL,1,LA7ISQN,3,LRISO)
  1.  ;
  1.  ;  ^LAB(61.39,1,2,"B","cec",100)
  1.  ;    -->OBX|1|ST|Gm|126|4|ug/ml||||F
  1.  S LRD1=$P($P($G(LA7OBX),LA7FS,4),LA7CS)
  1.  S LRD=$O(^LAB(61.39,1,2,"B",LRD1,0)) ;-->LIC FILE
  1.  ;I $G(LRD) S LRDNUM=$G(^LAB(61.39,1,2,LRD,1)) D
  1.  ;.  S LRMIC=$P($G(LA7OBX),LA7FS,6)
  1.  ;.  S LRINTRP=$P(LA7OBX,LA7FS,9)
  1.  ;.  S LRDNODE=$P(^LAB(62.06,LRDNUM,0),U,2) ; Pull out drug node (n.xxxx)
  1.  ;.  D INTERP
  1.  ;
  1.  I '$G(LRD) D DRUGS
  1.  QUIT  ;ihs/cmi/maw 03/08/2013 for MU removed quit
  1.  ;
  1.  ;---^LAHM(62.49,61,150,9,0) = OBX|1|CE|87993.0000^BACTERIOLOGY CULTURE^
  1.  ;---VANLT|1|^ESCHERICHIA COLI
  1.  ;
  1.  ;
  1.  ;  OBX|1|ST|126^^^||||||||F
  1.  ;  OBX-1 = 1
  1.  ;  OBX-2 = ST
  1.  ;  OBX-3 = 126^^^
  1.  ;  OBX-3-1 = 126
  1.  ;  OBX-11 = F
  1.  ;  OBR|2|3207||||||||||||||||MSCAN||||||||^1
  1.  ;  OBR-1 = 2
  1.  ;  OBR-2 = 3207
  1.  ;  OBR-18 = MSCAN
  1.  ;  OBR-26 = ^1
  1.  ;  OBR-26-2 = 1
  1.  ;  OBX|1|ST|Gm|126|4|ug/ml||||F
  1.  ;
  1.  ;
  1.  I $E(LA7OBX,1,3)="OBX",$P(LA7OBX,LA7FS,3)="CWE" D  QUIT  ;--ledi
  1.  .  S LRMIOBX=LA7OBX S LRORG=$P($P(LA7OBX,LA7FS,6),LA7CS) ;-->NLT^Name
  1.  .  ;
  1.  .  I $G(LRORG)'="" S LRORGNM=LRORG D ORG
  1.  ;
  1.  ;--->accomadate multiple life forms----\/
  1.  ;
  1.  ;
  1.  ;I $E(LA7OBX,1,3)="OBX",+$P(LA7OBX,LA7FS,6) S LRORGX=+$P(LA7OBX,LA7FS,6) D
  1.  ;
  1.  ;-->MICROSCAN data innovations  OBX|1|ST|ORGANISM|||||F
  1.  ;
  1.  ; check for culture ID only
  1.  I $E(LA7OBX,1,3)="OBX",+$P(LA7OBX,LA7FS,4) D  QUIT
  1.  . S LRORGX=+$P(LA7OBX,LA7FS,4)
  1.  . I $G(LRORGX),$D(^LAB(61,2,LRORGX,0)) D LRORGX
  1.  ;
  1.  ;
  1.  ;
  1.  ;
  1.  ; These bugs have susceptabilities
  1.  I $E(LA7OBX,1,3)="OBX",+$P(LA7OBX,LA7FS,5) D
  1.  . S LRORGX=+$P(LA7OBX,LA7FS,5)
  1.  . I $G(LRORGX),$D(^LAB(61,2,LRORGX,0)) D LRORGX
  1.  ;
  1.  ;
  1.  ;
  1.  QUIT
  1.  ;
  1. DRUGS    ;
  1.  ;---> all forms of HL7 can use this format
  1.  ;
  1.  ;  OBX|1|ST|Gm|126|4|ug/ml||||F
  1.  I $E(LA7OBX,1,3)="OBX",$P(LA7OBX,LA7FS,3)="SN" D
  1.  .  S LRAB=$P(LA7OBX,LA7FS,4) ;-->NLT^Name
  1.  .  Q:$G(LRAB)["ISO"
  1.  .  S LRMIC=$P(LA7OBX,LA7FS,6),LRINTRP=$P(LA7OBX,LA7FS,9)
  1.  .  I LRMIC="" D CREATE^LA7LOG(51)
  1.  .  ;I LRAB'="" D AB  ihs/cmi/maw MU2 orig code
  1.  .  I LRAB'="" D MS  ;ihs/cmi/maw MU2 lets try to get the drug
  1.  QUIT
  1. END      ;
  1.  K LRORG,LRORGX,LRORGNM,LRORGNUM,LRDNODE,LA7OBX,LRMIC,LRAB,LRINTRP,J,MIC,ISOL
  1.  K LRISO,LRMIFLAG,K1,ORG,LRSP
  1.  S LA7QUIT=1
  1.  QUIT
  1.  ;
  1. ORG      ;
  1.  ;***S LRISO=$P(LA7OBX,LA7FS,2)
  1.  ; ^LAB(61.2,1,64) = 923 ---> NLT for E.COLI
  1.  ; ^LAB(61.2,"NLT","87016.0000",1)
  1.  ;
  1.  ;---^LAH(65,1,12,0) = 1^1^12^2970000^6^^VITEK^6 --> set in LA7UIIN1
  1.  ;---^LAH(65,1,12,2,2) = CARD^gns-f6 ---> NA for Microscan
  1.  ;
  1.  ;---^LAH(65,1,12,3,4,0) = 1^^gns-f6 ---> organism
  1.  ;---^LAH(65,1,12,3,4,1,0) = ^F  --> status
  1.  ;
  1. NLT      S LRNLT=+LRORGNM I LRNLT S LRORGNUM=$O(^LAB(61.2,"NLT",LRNLT,0)) D
  1.  .  I LRORGNUM S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=LRORGNUM_U_U
  1.  Q:$G(LRORGNUM)
  1.  ;
  1. LIC      ;
  1.  S LRORGN=LRORGNM
  1.  I LRORGN S LRORGN=$O(^LAB(61.39,1,1,"B",LRORGN,0))
  1.  I LRORGN S LRORGNUM=^LAB(61.39,1,1,LRORGN,1) ; IEN ETIOLOGY FIELD
  1.  I $G(LRORGNUM),$D(^LAB(61.2,LRORGNUM,0)) D  QUIT
  1.  .  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=LRORGNUM_U_U
  1.  ;
  1. FILE     ;
  1.  S LRORGN=$G(LRORGNM)
  1.  I $D(LRORGN) S LRORGNUM=$O(^LAB(61.2,"B",LRORGN,0))
  1. LRORGX   I $G(LRORGNUM),$D(^LAB(61.2,LRORGNUM,0)) D  QUIT
  1.  .  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=LRORGNUM_U_U_U
  1.  .  S ^LAH(LA7LWL,1,LA7ISQN,"IHS")=$G(LA7VRS)  ;result status
  1.  .  ; D MKKDEBUG(LA7OBX,LA7MABN,"LRORGX")
  1.  .  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,"IHSOBX")=LA7MRES_U_LA7MUNIT_U_LA7MABN_U_LA7MRS_U_LA7MRSDT_U_LA7MPO_U_$G(LA7MPN)_U_$G(LA7PMD)
  1.  ;
  1.  ;
  1.  QUIT
  1. AB       ;
  1.  ;---^LAHM(62.49,61,150,13,0) = OBX|1|ST|81812.0000^Neomycin^VANLT^18^NEO
  1.  ;---MYCN^VA62.06||MIC|||R
  1.  ;
  1. NLTA     ;
  1.  S LRABNLT=$P(LRAB,U) Q:LRABNLT=""  ;  ---> Need nlt error code here?
  1.  ;---^LAB(62.06,"NLT","81098.0000",1)
  1.  I +LRABNLT S LRDRUG=$O(^LAB(62.06,"NLT",LRABNLT,0))
  1.  I $G(LRDRUG) S LRDNODE=$P(^LAB(62.06,LRDRUG,0),U,2) D  QUIT
  1.  . I LRDNODE D INTERP
  1.  ;
  1.  ;
  1. LIC1     ;
  1.  ;--> checks the LIC file for translation like for the Vitek
  1.  ;***** CHANGE----\/ To a variable
  1.  I '$P(LRAB,LA7CS,5) D MS QUIT
  1.  I '$D(^LAB(61.39,1,2,"B",$P(LRAB,LA7CS,5))) D MS QUIT
  1.  S LRAB=$P(LRAB,LA7CS,5)
  1.  S LRAB=$O(^LAB(61.39,1,2,"B",LRAB,""))
  1.  I +LRAB S LRAB=^LAB(61.39,1,2,LRAB,1) ; IEN ANTIMICROBIAL SUSCEP
  1.  S LRDNODE=$P(^LAB(62.06,LRAB,0),U,2) ; Pull out drug node (n.xxxx)
  1.  I LRDNODE D INTERP QUIT
  1.  ;
  1.  ;
  1. MS       ;
  1.  ;
  1.  I '$O(^LAB(62.4,LA7624,7,1,2,0)) D LAB6204 QUIT
  1.  S LRAB=$P(LRAB,U)
  1.  ; LA7624 = ien of instrument in file #62.4
  1.  ;---> ^LAB(62.4,LA7624,7,1,2,40,0) = 67^2.00693023^^AmS^9
  1.  ;--->  OBX|1|ST|A/S^^^||<8/4|ug/ml|||||F
  1.  S LRTIC=0
  1.  ;---------------->TEST TEST\/
  1.  S LRABIEN=$O(^LAB(62.4,LA7624,7,1,2,"C",LRAB,0))
  1.  I LRABIEN S LRNODE=LRABIEN ;D INTERP
  1.  Q:'LRABIEN  ;->FIX DRUG TX
  1.  S LRABIEN=+$G(^LAB(62.4,LA7624,7,1,2,LRABIEN,0))
  1.  S LRDNODE=$P($G(^LAB(62.06,LRABIEN,0)),U,2)
  1.  I LRDNODE D GETM
  1.  ;
  1.  ;
  1.  QUIT
  1.  F  S LRTIC=$O(^LAB(62.4,LA7624,7,1,2,LRTIC)) Q:+LRTIC'>0  S LRN=^(LRTIC,0) D
  1.  .  I $P(LRN,U,4)=LRAB S LRDNODE=$P(LRN,U,2) D
  1.  ..  I LRDNODE D GETM
  1.  ;
  1.  QUIT
  1. LAB6204  ;
  1.  ;
  1.  S LRN=$P(LRAB,LA7CS,5)
  1.  S LRNONDE=$P(^LAB(62.04,$O(^LAB(62.04,"B",LRN,0)),0),U,2)
  1.  ;---> LA7LOG LOGS THE ERRORS
  1.  ;
  1.  ;
  1. INTERP   ;------->all drugs go through here
  1.  ;------------------------------------------------------------------
  1.  ;---^LAH(65,1,12,3,4,2.0012) = 2^S^A  --->DRUG  MIC^INTERP^DISPLAY
  1.  ;
  1.  ;---> Need to apply the 69.9 challenge here...not for prototype.
  1.  ;  --> ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=$G(LRORGNUM)_U_U
  1.  ;
  1.  ;I '$G(LRORGNUM) S LRORGNUM=$O(^LAB(61.2,"B",LRORGNM,0))
  1.  ;S LRISO=0
  1.  ;F  S LRISO=$O(^TMP("LRISO",$J,LRISO)) Q:+LRISO'>0  D GETM
  1.  D GETM
  1.  Q
  1. GETM     ;
  1.  ;I ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=$G(^LAH(LA7LWL,1,LA7ISQN,3,LRISO-1,0))
  1.  ;  stop if no inter in la7obx
  1.  ;  OBX|1|ST|Ak|620|<=16|ug/ml||S||F
  1.  I $P(LA7OBX,LA7FS,6)'="" Q:$P(LA7OBX,LA7FS,9)=""
  1.  S LRORG=$P(LA7OBX,LA7FS,5)
  1.  S LA7ICNT=LA7ICNT+1
  1.  ;S LRISO=$O(^TMP("LRISO",$J,LRISOX,LRORG,0))
  1.  ;I '$G(LRISO) S LRISO=$O(^TMP("LRISO",$J,0))
  1.  ;I '$G(LRISO) S LRISO=1
  1.  D MKKDEBUG(LA7OBX,LA7MABN,"GETM")
  1.  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,"ISO",LA7ICNT)=$G(LRABIEN)_U_$G(LRDNODE)_U
  1.  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,"ISO","IHSOBX",LA7ICNT)=LA7MRES_U_LA7MUNIT_U_LA7MABN_U_LA7MRS_U_LA7MRSDT_U_LA7MPO_U_$G(LA7MPN)_U_$G(LA7PMD)
  1.  QUIT
  1.  ; .  S ^TMP("LRISO",$J,LRISO,LRORG)=""
  1.  ; .  S ^TMP("LRORG",$J,LRORG,LRISO)=""
  1.  K MIC
  1.  S LRSP=LA761
  1.  ;I '$G(LRORGNUM) D
  1.  ; .  I $G(LRORGNUM)'=$P(LA7OBX,LA7FS,5) S LRORGNUM=$P(LA7OBX,LA7FS,5) D
  1.  ; ..  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=LRORGNUM_U_U
  1.  ;I '$D(LRORGNUM) D CREATE^LA7LOG(52) ;-->NO ORG
  1.  ;I '$D(LRDNODE) D CREATE^LA7LOG(53) ;-->NO DRUG
  1.  S K1=$G(LRMIC)
  1.  Q:'$G(LRISO)
  1.  S ISOL=+$G(^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0))
  1.  ;
  1.  ;
  1.  Q:ISOL'>0
  1.  Q:'$G(LRDNODE)
  1.  ;S ORG(ISOL)=$P($G(^LAB(61.2,ISOL,0)),U)
  1.  S ORG(ISOL)=ISOL
  1.  S MIC(ISOL,LRDNODE)=$G(LRMIC)
  1.  S J=0
  1.  ;QUIT
  1.  F  S J=$O(MIC(ISOL,J)) Q:J<1  D
  1.  .  S K=MIC(ISOL,J)_"^"
  1.  .  D INTRP^LAMIVTE6 D  QUIT  ;--> Franko's interp program.
  1.  ..  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,J)=LRMIC_"^"_S
  1.  ..  S LA7INTRP=$P(LA7OBX,"|",9),LA7MIC=$P(LA7OBX,"|",6)
  1.  ..  S ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,J)=LA7MIC_U_LA7INTRP
  1.  ;
  1.  ;I LRISO>1 I ^LAH(LA7LWL,1,LA7ISQN,3,LRISO,0)=$G(^LAH(LA7LWL,1,LA7ISQN,3,LRISO-1,0)) K ^LAH(LA7LWL,1,LA7ISQN,3,LRISO)
  1.  QUIT
  1.  ;
  1. RPTFAC(LA7PRDID,LA7SFAC,LA7CS) ; Process/Store Producer's ID
  1.  ; Store where test was performed.
  1.  ; Call with LA7PRDID = Producer's ID field
  1.  ;            LA7SFAC = sending facility
  1.  ;              LA7CS = component encoding character
  1.  ;
  1.  N LA74,LA7X,LA7Y
  1.  ;
  1.  ;S LA7X=$P(LA7PRDID,LA7CS,2),LA74=""
  1.  S LA7X=LA7PRDID,LA74=""
  1.  ;
  1.  I $P(LA7PRDID,LA7CS,3)="99VA4" S LA74=$$FIND1^DIC(4,"","OMX",$P(LA7PRDID,LA7CS))
  1.  I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7PRDID,LA7CS),1,1)
  1.  ;I 'LA74 S LA74=$$FINDSITE^LA7VHLU2($P(LA7SFAC,LA7CS),1,1)
  1.  ;
  1.  ; Store producer's id in LAH global with results.
  1.  ;I LA74 S $P(^LAH(LA7LWL,1,LA7ISQN,LA76304),"^",9)=LA74
  1.  ;
  1.  Q $G(LA74)
  1.  ;
  1. MKKDEBUG(OBXSEG,ABNFLG,LABEL)  ; EP - DEBUG
  1.  Q    ; Don't use except during development
  1.  ;
  1.  S ^XTMP("LA7VCMI",$$HTE^XLFDT($H,"2MZ"),$J,LABEL,"ABNFLG")=ABNFLG
  1.  S ^XTMP("LA7VCMI",$$HTE^XLFDT($H,"2MZ"),$J,LABEL,"OBXSEG")=OBXSEG
  1.  Q