source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLAB2.m@ 808

IMRLAB2 ;HOIFO/SPS-MICROBIOLOGY DATA EXTRACT;01/14/02  11:14 ;
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**8,9,15**;Feb 09, 1998
 ; Called from IMRLAB routine
BAC ;
 S IMRRX1=$G(^LR(IMRRFN,IMRRTYP,IMRRD,1))
 S IMRRX1="BAC"_U_$P(IMRRX1,U,5,7)
 D BKLN
 I $D(^LR(IMRRFN,IMRRTYP,IMRRD,4,0)) D
 .S (IMRRX1,IMRRX2)="",IMRBR=0
 .F  S IMRBR=$O(^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR)) Q:IMRBR'>0  D
 ..Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR,0))
 ..S IMRRX2=^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR,0)
 ..Q:IMRRX2=""
 ..S IMRRX1="BRPT"_U_IMRRX2 D BKLN
 Q
GRAM ;
 S IMRRJ=0,(IMRRX1,IMRRX2)=""
 F  S IMRRJ=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ)) Q:IMRRJ'>0  D
 .S IMRRX2=$P(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,0),U)
 .Q:IMRRX2=""
 .S IMRRX1="GRAM"_U_IMRRX2
 .D BKLN
 Q
ORG ;
 S IMRLRTY=63.3
 N IMRRJ
 F IMRRJ=0:0 S IMRRJ=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ)) Q:IMRRJ'>0  D
 .I $D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,0)) D ORGCOM
 .I $D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,0)) S IMRRX2=$P(^(0),U,2),IMRRX1=+^(0),IMRRX1=$S($D(^LAB(61.2,IMRRX1,0)):$P(^(0),U),1:"")
 .I IMRRX1'="" S IMRRX1="ORG"_U_IMRRX1_U_IMRRX2_U_"1" S IMRRX2=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,2)) D:(IMRRX2>2&(IMRRX2<3))  D BKLN
 ..
 ..F IMRRK=2:0 S IMRRK=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,IMRRK)) Q:(IMRRK<2!(IMRRK'<3))  S IMRRX4=^(IMRRK),IMRRX3=$O(^DD(IMRLRTY,"GL",IMRRK,1,0)) D
 ...I IMRRX3>0,$D(^DD(IMRLRTY,IMRRX3,0)) S IMRRX3=$P(^(0),U)_U_IMRRX4 D:($L(IMRRX)+$L(IMRRX1)+$L(IMRRX3))>220 BKLN S IMRRX1=IMRRX1_U_IMRRX3
 ...Q
 ..Q
 .Q
 S (IMRCHL,IMRSEND)=1
 ; piece 2 date specimen taken
 ; piece 3 Site specimen
 ; piece 4 Collection sample
 ; piece 5 type or report
 ; piece 6 -any Organism/screen/gram stain/report,comment
 ; Quantity,Agent tested,Sensitivity
 Q
ORGCOM ;
 S IMRCMT=0,(IMRRX1,IMRRX2)=""
 F  S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT)) Q:IMRCMT'>0  D
 .Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT,0))
 .S IMRRX2=^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT,0)
 .Q:IMRRX2=""
 .S IMRRX1="ORGCOM"_U_IMRRX2 D BKLN
 Q
PAR ;
 N IMRPAR,IMRPARN,IMRPARST
 S (IMRRX1,IMRRX2,IMRRX3)="",(IMRPAR,IMRQS,IMRCMT,IMRPARST)=0
 F  S IMRPAR=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR)) Q:IMRPAR=""  D
 .Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,0))
 .S IMRPARN=+^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,0),IMRPARN=$P($G(^LAB(61.2,IMRPARN,0)),U,1)
 .F  S IMRQS=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS)) Q:IMRQS=""  D
 ..Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,0))
 ..S IMRRX2=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS))
 ..F  S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT)) Q:IMRCMT=""  D
 ...Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT,0))
 ...S IMRRX3=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT,0))
 ...S IMRRX1=IMRPARN_U_"PAR"_U_IMRRX2_U_IMRRX3_U_IMRRX4
 ...D BKLN
 Q
PARRPT ; Report
 S (IMRCMT,IMRRX2,IMRRX1)=""
 F  S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,7,IMRCMT)) Q:IMRCMT=""  D
 .S IMRRX2=$G(^LR(IMRRFN,IMRRTYP,IMRRD,7,IMRCMT,0))
 .Q:IMRRX2=""
 .S IMRRX1="PARRPT"_U_IMRRX2
 .D BKLN
 Q
COMSP ;Comment on Specimen
 S IMRRX1=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX))
 Q:IMRRX1=""
 S IMRRX1=99_U_IMRRX1
 D BKLN
 Q
 Q
BKLN ; Break Line
 S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)=IMRRX_U_IMRRX1,IMRRX1=$P(IMRRX1,U,1,2)_U_($P(IMRRX1,U,3)+1) S IMRSEND=1 D LCHK^IMRDAT
 Q