source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OB63A.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.8 KB
Line 
1LR7OB63A ;slc/dcm - Get Micro (Antibiotic level, Bact, Sterility) ;8/11/97
2 ;;5.2;LAB SERVICE;**121,153,187**;Sep 27, 1994
3 ;
4MI(SPECMEN) ;Microbiology
5 ;SPECMEN=ptr to 61, to specify specimen
6 N X,Y1,Y2,Y3,Y4,Y5,Y6,Y18,Y19,CTR1,IF,IFN,IFN1,ORG,QU,SSD,SIC1,SBC1,TM1,SIC2,SBC2,TM2,X1,X2,X3
7 Q:'$D(^LR(LRDFN,"MI",+$G(IVDT),0)) S X0=^(0),Y6=$S(+$G(CORRECT):"C",$P(X0,"^",3):"F",1:""),Y19=$P(X0,"^",5),CTR1=0
8 I $G(SPECMEN),Y19'=SPECMEN Q
9 S Y18=";MI;"_IVDT
10 I $D(^LR(LRDFN,"MI",IVDT,14)) S IFN=0 D ;Antibiotic level
11 . F S IFN=$O(^LR(LRDFN,"MI",IVDT,14,IFN)) Q:IFN<1 S X=^(IFN,0) D
12 .. S Y1=$P(X,"^")_" ("_$S($P(X,"^",2)="P":"PEAK",$P(X,"^",2)="T":"TROUGH",1:"")_")",Y2=$P(X,"^",3),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^"_"ug/ml"_"^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
13 ;
14 I $D(^LR(LRDFN,"MI",IVDT,1))#2 S X=^(1) D ;Bact
15 . S Y6=$S(+$G(CORRECT):"C",1:$P(X,"^",2))
16 . I $L($P(X,"^",5)) S Y1="SPUTUM SCREEN",Y2=$P(X,"^",5),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
17 . I $L($P(X,"^",6)) S Y1="URINE SCREEN",Y2=$S($P(X,"^",6)="N":"Negative",$P(X,"^",6)="P":"Positive",1:$P(X,"^",6)),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
18 . I $D(^LR(LRDFN,"MI",IVDT,2,0)) S Y1="GRAM STAIN",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,2,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
19 . I $D(^LR(LRDFN,"MI",IVDT,25,0)) S Y1="BACTERIOLOGY SMEAR/PREP",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,25,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
20 . I $D(^LR(LRDFN,"MI",IVDT,3,0)) S Y1="ORGANISM",IFN=0 D
21 .. F S IFN=$O(^LR(LRDFN,"MI",IVDT,3,IFN)) Q:IFN<1 S X=^(IFN,0),ORG=$P(X,"^"),ORG=$P($G(^LAB(61.2,+ORG,0)),"^"),QU=$P(X,"^",2),SSD=$P(X,"^",3,8) D
22 ... I SSD'?."^" S SIC1=$P(SSD,"^"),SBC1=$P(SSD,"^",2),TM1=$P(SSD,"^",3),SIC2=$P(SSD,"^",4),SBC2=$P(SSD,"^",5),TM2=$P(SSD,"^",6),SSD=1
23 ... I SSD S X1="" D S Y1=Y1_" "_X1
24 .... I $L(SIC1) S X1="SIT "_$S($L(TM1):"("_TM1_")",1:"")_": "_SIC1
25 .... I $L(SBC1) S X1=$S($L(X1):", ",1:"")_"SBT "_$S($L(TM1):"("_TM1_")",1:"")_": "_SBC1
26 .... I $L(SIC2) S X1=$S($L(X1):", ",1:"")_"SIT "_$S($L(TM2):"("_TM2_")",1:"")_": "_SIC2
27 .... I $L(SBC2) S X1=$S($L(X1):", ",1:"")_"SBT "_$S($L(TM2):"("_TM2_")",1:"")_": "_SBC2
28 ... S Y2=ORG_";"_QU,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
29 ... S IF=0 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,3,IF)) Q:IF<1 S X1=^(IF,0),Y1=$P(X1,"^"),Y2=$P(X1,"^",2)_";MIC^"_$P(X1,"^",3)_";MBC",CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^ug/ml^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
30 ... S IF=0 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,1,IF)) Q:IF<1 S X=^(IF,0),^TMP("LRX",$J,69,CTR,63,"N",IF)=X
31 ... S IF=2 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,IF)) Q:IF<1!(IF'["2.") S X=^(IF),Y1=$P(X,"^",1),Y2=$P(X,"^",2),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
32 . I $D(^LR(LRDFN,"MI",IVDT,4,0)) S Y1="Bacteriology Remark(s)",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,4,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
33 ;
34 I $D(^LR(LRDFN,"MI",IVDT,31)) D ;Sterility
35 . S Y1="STERILITY CONTROL",Y2=$S($L($P(^LR(LRDFN,"MI",IVDT,1),"^",7)):$S($P(^(1),"^",7)="N":"Negative",1:"Positive"),1:""),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
36 . S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,31,IFN)) Q:IFN<1 S X=^(IFN,0),Y2=X,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
37 ;
38 D MI^LR7OB63B
39 I $D(^LR(LRDFN,"MI",IVDT,99)) S Y1="Comments on Specimen",Y2=^(99),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,"N",CTR1)=Y1_": "_Y2
40 Q
Note: See TracBrowser for help on using the repository browser.