source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMROLAB.m@ 1147

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1IMROLAB ;HCIOFO/FAI-LOOKUP LAB TEST VALUES ;09/01/00 06:10 ;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3 ; called from IMRPINQ routine
4BEGIN K ^TMP("IMRLABS",$J) D HEAD,FIRST,SORT
5 K ^TMP("IMRLABS",$J)
6 Q
7FIRST S IMRL=0 F S IMRL=$O(IMRLABS(IMRL)) Q:IMRL="" S IMLO=IMRLABS(IMRL) D FIND
8 Q
9FIND S LNM=$P($G(^LAB(60,IMLO,0)),U,1),LLOC=$P($G(^LAB(60,IMLO,0)),U,5)
10 I LLOC'="" S UNN=$P($G(^LAB(60,IMLO,1,0)),U,3),LDAT=$P(LLOC,";",2) S:UNN'="" UNS=$P($G(^LAB(60,IMLO,1,UNN,0)),U,7) D CHEMS Q
11 I LLOC="" D PANEL Q
12 Q
13PANEL F PN=0:0 S PN=$O(^LAB(60,IMLO,2,PN)) Q:PN'>0 S LPN=$P($G(^LAB(60,IMLO,2,PN,0)),U,1),LNM=$P($G(^LAB(60,LPN,0)),U,1),LLOC=$P($G(^LAB(60,LPN,0)),U,5) D PAN2
14 Q
15PAN2 S UNN=$P($G(^LAB(60,LPN,1,0)),U,3)
16 S:UNN'="" UNS=$P($G(^LAB(60,LPN,1,UNN,0)),U,7)
17 S:LLOC'="" LDAT=$P(LLOC,";",2)
18 D CHEMS
19 Q
20CHEMS Q:$G(LDAT)="" S LDT="" F S LDT=$O(^LR(ILR,"CH",LDT)),DNAM="" Q:LDT="" F S DNAM=$O(^LR(ILR,"CH",LDT,DNAM)) Q:DNAM="" S LRES=$P($G(^LR(ILR,"CH",LDT,LDAT)),U,1),(DTRC,LDO)=$P($G(^LR(ILR,"CH",LDT,0)),U,1) D PLBS
21 Q
22PLBS Q:LRES=""
23 S Y=DTRC D DD^%DT S (DTAA,DTRC)=Y
24 S DTR1=$E(DTAA,1,3),DTR2=$E(DTAA,9,12),DTRD=DTR1_","_DTR2
25 S DTRC=$E(DTRC,1,18)
26 Q:(LDO<IMRHNBEG)!(LDO>IMRHNEND)
27 S LDO=$E(LDO,1,10)
28 S ^TMP("IMRLABS",$J,LDO,LNM)=LNM_U_UNS_U_LRES_U_DTRC
29 Q
30HEAD W !!,?9,"**** S E L E C T E D L A B T E S T S ****",!!,"DATE",?26,"TEST",?44,"UNITS",?54,"RESULT",!,"----",?26,"-----",?44,"-----",?54,"-------"
31 Q
32SORT I '$D(^TMP("IMRLABS",$J)) W !!,"***NO DATA FOUND FOR THIS TIME PERIOD***" Q
33 S MDT="" F S MDT=$O(^TMP("IMRLABS",$J,MDT)),LAB="" Q:MDT="" F S LAB=$O(^TMP("IMRLABS",$J,MDT,LAB)) Q:LAB="" S RC=^TMP("IMRLABS",$J,MDT,LAB) D SRT1
34 Q
35SRT1 S IMTEST=$P(RC,U,1),IMUNS=$P(RC,U,2),IMRRES=$P(RC,U,3),IMDT=$P(RC,U,4) Q:IMRRES="" W !,IMDT,?25,IMTEST,?45,IMUNS,?55,IMRRES
36 Q
Note: See TracBrowser for help on using the repository browser.