37 lines
1.8 KiB
Mathematica
37 lines
1.8 KiB
Mathematica
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
|