source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDV05X.m@ 949

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1ORDV05X ; slc/jdl - Microbiology Extended Extracts ;6/13/2001 11:59AM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,208**;Dec 17, 1997
3 ;;Called from ORDV05E, return ^TMP("ORM",$J in GCPR format
4 ;;For Parasitology,Mycology,Mycobacteriology,Virology in GCPR
5PARA ; Get Parasitology Work-up
6 N DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM,PARAIEN
7 I $D(^LR(LRDFN,"MI",IX,5)) D
8 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=15,DIQ="STATUS"
9 . S DIQ(0)="E" D EN^DIQ1
10 . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,15,"E")," ",1),1,6)
11 S PN=0
12 F S PN=$O(^LR(LRDFN,"MI",IX,6,PN)) Q:+PN'>0 D
13 . S PARAIEN=+^LR(LRDFN,"MI",IX,6,PN,0),SN=0
14 . D IDPARA
15 . F S SN=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN)) Q:+SN'>0 D IDPARA
16 ; Parasitology smear/prep
17 S SMEAR=0
18 F S SMEAR=$O(^LR(LRDFN,"MI",IX,24,SMEAR)) Q:SMEAR'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","PARA","SMEAR",SMEAR)=^(SMEAR,0)
19 ; remark
20 S RMK=0
21 F S RMK=$O(^LR(LRDFN,"MI",IX,7,RMK)) Q:+RMK'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","PARA","RMK",RMK)=^(RMK,0)
22 Q
23IDPARA ;Get parasite stage, quantity, and comment
24 N DA,DIC,DIQ,DR,PARA,STAGE
25 I 'SN S PARA=$S($D(EXPAND):PN_";"_$P(^LAB(61.2,PARAIEN,0),U),1:$P(^LAB(61.2,PARAIEN,0),U)),^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN)="P"_U_PARA Q
26 S DA=LRDFN,DA(63.05)=IX,DA(63.34)=PN,DA(63.35)=SN,DIC=63,DIQ="STAGE",DIQ(0)="E",DR=5,DR(63.05)=16,DR(63.34)=1,DR(63.35)=".01;1" D EN^DIQ1
27 S ^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
28 ;comment
29 S COM=0
30 F S COM=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",PARAIEN,SN,COM)=^(COM,0)
31 Q
32MYCO ; Get Mycology Work-up
33 N DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR,MYCOIEN
34 I $D(^LR(LRDFN,"MI",IX,8)) D
35 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=19,DIQ="STATUS"
36 . S DIQ(0)="E" D EN^DIQ1
37 . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,19,"E")," ",1),1,6)
38 S ISO=0
39 F S ISO=$O(^LR(LRDFN,"MI",IX,9,ISO)) Q:+ISO'>0 D
40 . S MYCOIEN=+^LR(LRDFN,"MI",IX,9,ISO,0)
41 . D FNGS S ^TMP("ORM",$J,RPT,SS,"RPT",MYCOIEN)="M"_U_$S($D(EXPAND):ISO_";"_FUN,1:FUN)
42 . ;comment
43 . S COM=0
44 . F S COM=$O(^LR(LRDFN,"MI",IX,9,ISO,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",MYCOIEN,"COM",COM)=^(COM,0)
45 ; Mycology smear/prep
46 S SMEAR=0
47 F S SMEAR=$O(^LR(LRDFN,"MI",IX,15,SMEAR)) Q:SMEAR'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","MYCO","SMEAR",SMEAR)=^(SMEAR,0)
48 ; remark
49 S RMK=0
50 F S RMK=$O(^LR(LRDFN,"MI",IX,10,RMK)) Q:+RMK'>0 S ^TMP("ORM",$J,RPT,SS,"IMP","MYCO","RMK",RMK)=^(RMK,0)
51 Q
52FNGS N QTY
53 S FUN=+^LR(LRDFN,"MI",IX,9,ISO,0),QTY=$P(^(0),U,2),FUN=$P(^LAB(61.2,FUN,0),U)
54 S FUN=FUN_U_QTY
55 Q
56TB ; Gets Mycobacteriology Work-up
57 N DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,Y,COM,MY,GMTB,GMTBA,TBIEN
58 I $D(^LR(LRDFN,"MI",IX,11)) D
59 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="23;24;25",DIQ="STATUS"
60 . S DIQ(0)="E" D EN^DIQ1
61 . ;Status, Acid Fast Stain, Quantity
62 . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,23,"E")," ",1),1,6)
63 . S ^TMP("ORM",$J,RPT,SS,"IMP","TB","ACID FAST STAIN")=STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
64 S ISO=0
65 F S ISO=$O(^LR(LRDFN,"MI",IX,12,ISO)) Q:+ISO'>0 D
66 . S TBIEN=+^LR(LRDFN,"MI",IX,12,ISO,0)
67 . D MYCB S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN)="TB"_U_$S($D(EXPAND):ISO_";"_MB,1:MB)
68 . ;comment
69 . S COM=0
70 . F S COM=$O(^LR(LRDFN,"MI",IX,12,TBIEN,1,COM)) Q:COM'>0 S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN,"COM",COM)=^(COM,0)
71 . ;Susceptiblities
72 . S GMTB=2
73 . F S GMTB=$O(^LR(LRDFN,"MI",IX,12,ISO,GMTB)) Q:GMTB'["2."!(GMTB="") D
74 . . S GMTBA=+$O(^DD(63.39,"GL",GMTB,1,0))
75 . . S GMTBA=$$GET1^DID(63.39,GMTBA,"","LABEL")
76 . . S ^TMP("ORM",$J,RPT,SS,"RPT",TBIEN,GMTB)=GMTBA_U_$P(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
77 ; remark
78 S RMK=0
79 F S RMK=$O(^LR(LRDFN,"MI",IX,13,RMK)) Q:RMK="" S ^TMP("ORM",$J,RPT,SS,"IMP","TB","RMK",RMK)=^(RMK,0)
80 Q
81MYCB N QTY
82 S QTY=$P(^(0),U,2),MB=$P(^LAB(61.2,TBIEN,0),U)
83 S MB=MB_U_QTY
84 Q
85VIRO ; Gets Virology Work-up
86 N BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS,VIROIEN
87 I $D(^LR(LRDFN,"MI",IX,16)) D
88 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=34,DIQ="STATUS"
89 . S DIQ(0)="E" D EN^DIQ1
90 . S ^TMP("ORM",$J,RPT,SS)=^TMP("ORM",$J,RPT,SS)_U_$E($P(STATUS(63.05,IX,34,"E")," ",1),1,6)
91 S ISO=0
92 F S ISO=$O(^LR(LRDFN,"MI",IX,17,ISO)) Q:+ISO'>0 D
93 . S VIROIEN=+^LR(LRDFN,"MI",IX,17,ISO,0)
94 . D PHAGE S ^TMP("ORM",$J,RPT,SS,"RPT",VIROIEN)="V"_U_$S($D(EXPAND):ISO_";"_BUG,1:BUG)
95 S RMK=0
96 F S RMK=$O(^LR(LRDFN,"MI",IX,18,RMK)) Q:RMK="" S ^TMP("ORM",$J,RPT,SS,"IMP","VIRO","RMK",RMK)=^(RMK,0)
97 Q
98PHAGE S BUG=$P(^LAB(61.2,VIROIEN,0),U)
99 Q
Note: See TracBrowser for help on using the repository browser.