source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRM.m@ 1270

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

initial load of WorldVistAEHR
File size: 4.6 KB
Line 
1GMTSLRM ; SLC/JER,KER - Microbiology Component Driver ; 09/21/2001
2 ;;2.7;Health Summary;**28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 525 ^LR( all fields
6 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
7 ; DBIA 2056 $$GET1^DIQ (file 2)
8 ;
9MAIN ; Microbiology
10 N IX0,IX,LRDFN,MAX,D1,D2,D3
11 S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0 Q:'$D(^LR(LRDFN))
12 Q:+($S('$D(^LR(LRDFN,"MI",0)):1,'$O(^LR(LRDFN,"MI",GMTS1)):1,$O(^(GMTS1))>GMTS2:1,1:0))
13 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),IX=GMTS1
14 F IX0=1:1:MAX S IX=$O(^LR(LRDFN,"MI",IX)) Q:+IX'>0!(IX>GMTS2)!$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) D Q:$D(GMTSQIT)
15 . D ^GMTSLRME I $D(^TMP("LRM",$J)) D:IX0>1 CKP^GMTSUP Q:$D(GMTSQIT) W:IX0>1 ! D INTRP
16 . K ^TMP("LRM",$J)
17 Q
18INTRP ; Interprets ^TMP("LRM",$J
19 N GMZ,GMK S (GMZ,GMK)=""
20 F S GMZ=$O(^TMP("LRM",$J,GMZ)) Q:GMZ="" D RDNODE Q:$D(GMTSQIT)
21 Q
22RDNODE ; Reads current node of ^TMP("LRM",$J
23 N GMABX,COM S GMABX=0 I GMZ=0 D Q
24 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?10,"Collected:",?21,$P(^TMP("LRM",$J,GMZ),U),?43,"Acc:",?48,$P(^TMP("LRM",$J,GMZ),U,2),!
25 . I $P(^TMP("LRM",$J,GMZ),U,6)'=$P(^(GMZ),U,3) D
26 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,"Collection Sample:",?21,$P(^TMP("LRM",$J,GMZ),U,6),!
27 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Site/Specimen:",?21,$TR($P(^TMP("LRM",$J,GMZ),U,3),"|"," "),!
28 . S COM=$P(^TMP("LRM",$J,GMZ),U,7)
29 . I COM]"" D
30 . . D CKP^GMTSUP Q:$D(GMTSQIT)
31 . . W "Comment on Specimen:"
32 . . I $L(COM)>58 S COM=$$WRAP^GMTSORC(COM,58)
33 . . W ?21,$P(COM,"|"),!
34 . . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?22,$P(COM,"|",2),!
35 . D WRTTEST^GMTSLRM1
36 S GMK="" F S GMK=$O(^TMP("LRM",$J,GMZ,GMK)) Q:GMK="" D WRTNODE Q:$D(GMTSQIT)
37 Q
38WRTNODE ; Writes current node of ^TMP("LRM",$J
39 N GML,SMEAR,QTY,ORG,GMN,RSMEAR
40 I GMZ="BSTER" D Q
41 . I GMK=0 D Q
42 . . Q:$P(^TMP("LRM",$J,"BSTER",GMK),U)']""
43 . . D CKP^GMTSUP Q:$D(GMTSQIT)
44 . . W ?2,"Sterility Control:",?21,$P(^TMP("LRM",$J,"BSTER",GMK),U),! Q
45 . D CKP^GMTSUP I $D(GMTSQIT)
46 . W ?13,"Number:",?21,GMK,?34,"Sterility Results: ",$P(^TMP("LRM",$J,GMZ,GMK),U),!
47 I GMK=0 S GMN=$G(^TMP("LRM",$J,GMZ,GMK)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,$S(GMZ="BACT":" Bact ",GMZ="TB":"Mycobact ",GMZ="MYCO":"Mycology ",GMZ="PARA":"Parasite ",GMZ="VIRO":"Virology ",1:" ")_"Report:",?21,$P(GMN,U),! D Q
48 . I GMZ="BACT" D Q:$D(GMTSQIT)
49 . . I $P(GMN,U,3)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?7,"Urine Screen: ",$P(GMN,U,3),!
50 . . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Sputum Screen: ",$P(GMN,U,2),!
51 . I GMZ="TB" D Q:$D(GMTSQIT)
52 . . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Acid Fast Stain: ",$E($P(GMN,U,2),1,20) D
53 . . . S QTY=$P(GMN,U,3)
54 . . . I $L(QTY)>35 S QTY=$$WRAP^GMTSORC(QTY,35)
55 . . . W ?44,$P(QTY,"|"),!
56 . . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?44,$P(QTY,"|",2),!
57 I GMZ="GRAM" D WRTGRM^GMTSLRM1 Q
58 I GMK="SMEAR" D Q
59 . D CKP^GMTSUP Q:$D(GMTSQIT)
60 . W ?9,"Smear/Prep:"
61 . S SMEAR=0
62 . F S SMEAR=$O(^TMP("LRM",$J,GMZ,GMK,SMEAR)) Q:SMEAR'>0 D I +$O(^TMP("LRM",$J,GMK,SMEAR)) D CKP^GMTSUP Q:$D(GMTSQIT)
63 . . S RSMEAR=^TMP("LRM",$J,GMZ,GMK,SMEAR)
64 . . I $L(RSMEAR)>58 S RSMEAR=$$WRAP^GMTSORC(RSMEAR,58)
65 . . W ?21,$P(RSMEAR,"|"),!
66 . . I $L($P(RSMEAR,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?22,$P(RSMEAR,"|",2),!
67 I GMK="R" D REMARKS^GMTSLRM1 Q
68 I GMZ'="CABXL" D Q:$D(GMTSQIT)
69 . S ORG=$P(^TMP("LRM",$J,GMZ,GMK),U),QTY=$P(^(GMK),U,2)
70 . I $L(ORG)>58 S ORG=$$WRAP^GMTSORC(ORG,58)
71 . D CKP^GMTSUP Q:$D(GMTSQIT)
72 . W ?11,"Organism:"
73 . W ?21,$P(ORG,"|",1),!
74 . I $L($P(ORG,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(ORG,"|",2),!
75 . I QTY]"" W ?11,"Quantity:" D
76 . . I $L(QTY)>58 S QTY=$$WRAP^GMTSORC(QTY,58)
77 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P(QTY,"|"),!
78 . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(QTY,"|",2),!
79 . D COMMENT^GMTSLRM1 Q:$D(GMTSQIT)
80 . I GMZ="TB" D TBSUSC^GMTSLRM1
81 I GMZ="CABXL" D
82 . I GMK=1!(GMABX=1) D CKP^GMTSUP Q:$D(GMTSQIT) W ?8,"Ser Abx Lev:"
83 . W ?21,$E($P(^TMP("LRM",$J,GMZ,GMK),U),1,20),?45,$$DRAW($P(^TMP("LRM",$J,GMZ,GMK),U,2)),?55,$P(^TMP("LRM",$J,GMZ,GMK),U,3)," ug/ml",! D CKP^GMTSUP Q:$D(GMTSQIT)
84 I GMZ="BACT",$D(^TMP("LRM",$J,GMZ,GMK,"SUSC")) D ANTIBX^GMTSLRM1 Q
85 I GMZ="PARA",$D(^TMP("LRM",$J,GMZ,GMK))=11 D
86 . S GML=0
87 . F S GML=$O(^TMP("LRM",$J,GMZ,GMK,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
88 . . D CKP^GMTSUP Q:$D(GMTSQIT)
89 . . W ?23,$P(^TMP("LRM",$J,GMZ,GMK,GML),U)
90 . . S QTY=$P(^TMP("LRM",$J,GMZ,GMK,GML),U,2)
91 . . I $L(QTY)>34 S QTY=$$WRAP^GMTSORC(QTY,34)
92 . . W ?45,$P(QTY,"|"),!
93 . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?45,$P(QTY,"|",2),!
94 . . D PARACOMM^GMTSLRM1
95 Q
96DRAW(CODE) ; Peak/Trough/Random Abx level
97 Q $S(CODE="P":"PEAK",CODE="T":"TROUGH",1:"RANDOM")
Note: See TracBrowser for help on using the repository browser.