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

IMROLAB ;HCIOFO/FAI-LOOKUP LAB TEST VALUES ;09/01/00 06:10 ;
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
 ; called from IMRPINQ routine
BEGIN K ^TMP("IMRLABS",$J) D HEAD,FIRST,SORT
 K ^TMP("IMRLABS",$J)
 Q
FIRST S IMRL=0 F  S IMRL=$O(IMRLABS(IMRL)) Q:IMRL=""  S IMLO=IMRLABS(IMRL) D FIND
 Q
FIND S LNM=$P($G(^LAB(60,IMLO,0)),U,1),LLOC=$P($G(^LAB(60,IMLO,0)),U,5)
 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
 I LLOC="" D PANEL Q
 Q
PANEL 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
 Q
PAN2 S UNN=$P($G(^LAB(60,LPN,1,0)),U,3)
 S:UNN'="" UNS=$P($G(^LAB(60,LPN,1,UNN,0)),U,7)
 S:LLOC'="" LDAT=$P(LLOC,";",2)
 D CHEMS
 Q
CHEMS 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
 Q
PLBS Q:LRES=""
 S Y=DTRC D DD^%DT S (DTAA,DTRC)=Y
 S DTR1=$E(DTAA,1,3),DTR2=$E(DTAA,9,12),DTRD=DTR1_","_DTR2
 S DTRC=$E(DTRC,1,18)
 Q:(LDO<IMRHNBEG)!(LDO>IMRHNEND)
 S LDO=$E(LDO,1,10)
 S ^TMP("IMRLABS",$J,LDO,LNM)=LNM_U_UNS_U_LRES_U_DTRC
 Q
HEAD 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,"-------"
 Q
SORT I '$D(^TMP("IMRLABS",$J)) W !!,"***NO DATA FOUND FOR THIS TIME PERIOD***" Q
 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
 Q
SRT1 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
 Q