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

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1IMRLAB2 ;HOIFO/SPS-MICROBIOLOGY DATA EXTRACT;01/14/02 11:14 ;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**8,9,15**;Feb 09, 1998
3 ; Called from IMRLAB routine
4BAC ;
5 S IMRRX1=$G(^LR(IMRRFN,IMRRTYP,IMRRD,1))
6 S IMRRX1="BAC"_U_$P(IMRRX1,U,5,7)
7 D BKLN
8 I $D(^LR(IMRRFN,IMRRTYP,IMRRD,4,0)) D
9 .S (IMRRX1,IMRRX2)="",IMRBR=0
10 .F S IMRBR=$O(^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR)) Q:IMRBR'>0 D
11 ..Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR,0))
12 ..S IMRRX2=^LR(IMRRFN,IMRRTYP,IMRRD,4,IMRBR,0)
13 ..Q:IMRRX2=""
14 ..S IMRRX1="BRPT"_U_IMRRX2 D BKLN
15 Q
16GRAM ;
17 S IMRRJ=0,(IMRRX1,IMRRX2)=""
18 F S IMRRJ=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ)) Q:IMRRJ'>0 D
19 .S IMRRX2=$P(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,0),U)
20 .Q:IMRRX2=""
21 .S IMRRX1="GRAM"_U_IMRRX2
22 .D BKLN
23 Q
24ORG ;
25 S IMRLRTY=63.3
26 N IMRRJ
27 F IMRRJ=0:0 S IMRRJ=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ)) Q:IMRRJ'>0 D
28 .I $D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,0)) D ORGCOM
29 .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:"")
30 .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
31 ..
32 ..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
33 ...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
34 ...Q
35 ..Q
36 .Q
37 S (IMRCHL,IMRSEND)=1
38 ; piece 2 date specimen taken
39 ; piece 3 Site specimen
40 ; piece 4 Collection sample
41 ; piece 5 type or report
42 ; piece 6 -any Organism/screen/gram stain/report,comment
43 ; Quantity,Agent tested,Sensitivity
44 Q
45ORGCOM ;
46 S IMRCMT=0,(IMRRX1,IMRRX2)=""
47 F S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT)) Q:IMRCMT'>0 D
48 .Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT,0))
49 .S IMRRX2=^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRRJ,1,IMRCMT,0)
50 .Q:IMRRX2=""
51 .S IMRRX1="ORGCOM"_U_IMRRX2 D BKLN
52 Q
53PAR ;
54 N IMRPAR,IMRPARN,IMRPARST
55 S (IMRRX1,IMRRX2,IMRRX3)="",(IMRPAR,IMRQS,IMRCMT,IMRPARST)=0
56 F S IMRPAR=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR)) Q:IMRPAR="" D
57 .Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,0))
58 .S IMRPARN=+^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,0),IMRPARN=$P($G(^LAB(61.2,IMRPARN,0)),U,1)
59 .F S IMRQS=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS)) Q:IMRQS="" D
60 ..Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,0))
61 ..S IMRRX2=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS))
62 ..F S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT)) Q:IMRCMT="" D
63 ...Q:'$D(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT,0))
64 ...S IMRRX3=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX,IMRPAR,1,IMRQS,1,IMRCMT,0))
65 ...S IMRRX1=IMRPARN_U_"PAR"_U_IMRRX2_U_IMRRX3_U_IMRRX4
66 ...D BKLN
67 Q
68PARRPT ; Report
69 S (IMRCMT,IMRRX2,IMRRX1)=""
70 F S IMRCMT=$O(^LR(IMRRFN,IMRRTYP,IMRRD,7,IMRCMT)) Q:IMRCMT="" D
71 .S IMRRX2=$G(^LR(IMRRFN,IMRRTYP,IMRRD,7,IMRCMT,0))
72 .Q:IMRRX2=""
73 .S IMRRX1="PARRPT"_U_IMRRX2
74 .D BKLN
75 Q
76COMSP ;Comment on Specimen
77 S IMRRX1=$G(^LR(IMRRFN,IMRRTYP,IMRRD,IMRX))
78 Q:IMRRX1=""
79 S IMRRX1=99_U_IMRRX1
80 D BKLN
81 Q
82 Q
83BKLN ; Break Line
84 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
85 Q
Note: See TracBrowser for help on using the repository browser.