| 1 | IMROLAB ;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
|
|---|
| 4 | BEGIN K ^TMP("IMRLABS",$J) D HEAD,FIRST,SORT
|
|---|
| 5 | K ^TMP("IMRLABS",$J)
|
|---|
| 6 | Q
|
|---|
| 7 | FIRST S IMRL=0 F S IMRL=$O(IMRLABS(IMRL)) Q:IMRL="" S IMLO=IMRLABS(IMRL) D FIND
|
|---|
| 8 | Q
|
|---|
| 9 | FIND 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
|
|---|
| 13 | 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
|
|---|
| 14 | Q
|
|---|
| 15 | PAN2 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
|
|---|
| 20 | 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
|
|---|
| 21 | Q
|
|---|
| 22 | PLBS 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
|
|---|
| 30 | 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,"-------"
|
|---|
| 31 | Q
|
|---|
| 32 | SORT 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
|
|---|
| 35 | 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
|
|---|
| 36 | Q
|
|---|
