| [613] | 1 | GMTSLRSE ; SLC/JER,KER - Selected Lab Test Extract ; 09/21/2001
|
|---|
| 2 | ;;2.7;Health Summary;**28,36,47,79**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 67 ^LAB(60
|
|---|
| 6 | ; DBIA 524 ^LAB(61
|
|---|
| 7 | ; DBIA 525 ^LR(
|
|---|
| 8 | ;
|
|---|
| 9 | XTRCT ; Extract Selected Lab Test
|
|---|
| 10 | ;
|
|---|
| 11 | ; Call with LRDFN lab patient
|
|---|
| 12 | ; GMTS1 begin date
|
|---|
| 13 | ; GMTS2 end date
|
|---|
| 14 | ; MAX occurence limit
|
|---|
| 15 | ; SEX "M" or "F"
|
|---|
| 16 | ; TEST IFN to ^LAB(60)
|
|---|
| 17 | ; RWIDTH optional
|
|---|
| 18 | ;
|
|---|
| 19 | ; Returns ^TMP("LRS",$J,GMTSI,IDRWDT)=
|
|---|
| 20 | ; DRWDT^SPEC^TEST^RESULT^FLAG^UNIT^LO^HI
|
|---|
| 21 | ;
|
|---|
| 22 | ; Where GMTSI=Order (1 to MAX)
|
|---|
| 23 | ; IDRWDT=9999999-Draw Date/time
|
|---|
| 24 | ; DRWDT=Draw Date/Time (internal)
|
|---|
| 25 | ; SPEC=Specimen (int;ext)
|
|---|
| 26 | ; TEST=Test (int;ext)
|
|---|
| 27 | ; RESULT=Numeric Result
|
|---|
| 28 | ; FLAG=Reference flag (H,*H,L,*L)
|
|---|
| 29 | ; UNIT=Unit of measure (ext)
|
|---|
| 30 | ; LO=Reference/Therapeutic Lower bound
|
|---|
| 31 | ; HI=Ref/Ther Upper Bound
|
|---|
| 32 | ;
|
|---|
| 33 | N CNT,AGE,COM,GMI,X K ^TMP("LRS",$J,GMTSI) I $S("BO"'[$P(^LAB(60,TEST,0),U,3):1,1:0) Q
|
|---|
| 34 | D DEM^GMTSU S AGE=GMTSAGE S CNT=0 D CHEM:$P(^LAB(60,TEST,0),U,4)="CH"
|
|---|
| 35 | Q
|
|---|
| 36 | CHEM ; Gets all Chemistry tests w/in time/occurrence constraints
|
|---|
| 37 | N PTR,IDRWDT S PTR=+$P($P(^LAB(60,+TEST,0),U,5),";",2),IDRWDT=GMTS1
|
|---|
| 38 | F S IDRWDT=$O(^LR(LRDFN,"CH",IDRWDT)) Q:'IDRWDT!(IDRWDT>GMTS2)!(CNT'<MAX) I $P(^(IDRWDT,0),U,3),($D(^(PTR))) S CNT=CNT+1 D:CNT'>MAX CHSET
|
|---|
| 39 | Q
|
|---|
| 40 | CHSET ; Sets Chemistry locals for printing
|
|---|
| 41 | N RESULT,FLAG,DRWDT,SITE,SPEC,TNM,DESCR,THER,UNIT,HI,LO,GMIDT,GMTSLRES
|
|---|
| 42 | S GMTSLRES=$$TSTRES^LRRPU(LRDFN,"CH",IDRWDT,PTR)
|
|---|
| 43 | ; S RESULT=$P(^LR(LRDFN,"CH",IDRWDT,PTR),U),FLAG=$P(^(PTR),U,2),DRWDT=9999999-IDRWDT
|
|---|
| 44 | S RESULT=$P(GMTSLRES,U,1),FLAG=$P(GMTSLRES,U,2),DRWDT=9999999-IDRWDT
|
|---|
| 45 | S RESULT=$$RESULT^GMTSLRCE(TEST,RESULT,$G(RWIDTH))
|
|---|
| 46 | S X=DRWDT D REGDTM4^GMTSU S DRWDT=X K X
|
|---|
| 47 | S SITE=$P(^LR(LRDFN,"CH",IDRWDT,0),U,5),SPEC=SITE_";"_$P(^LAB(61,SITE,0),U)
|
|---|
| 48 | S TNM=TEST_";"_$S($L($P(^LAB(60,TEST,0),U))<21:$P(^(0),U),1:$P(^(.1),U))
|
|---|
| 49 | ; S DESCR=$S($D(^LAB(60,TEST,1,SITE,0)):^(0),1:""),THER=$S($L($P(DESCR,U,11,12))>1:1,1:0)
|
|---|
| 50 | ; S UNIT=$P(DESCR,U,7),LO=$S(THER:$P(DESCR,U,11),1:$P(DESCR,U,2)),HI=$S(THER:$P(DESCR,U,12),1:$P(DESCR,U,3))
|
|---|
| 51 | S UNIT=$P(GMTSLRES,U,5),LO=$P(GMTSLRES,U,3),HI=$P(GMTSLRES,U,4)
|
|---|
| 52 | ; S @("LO="_$S($L(LO):LO,1:"""""")),@("HI="_$S($L(HI):HI,1:""""""))
|
|---|
| 53 | I $D(^TMP("LRS",$J,GMTSI,IDRWDT)) S GMIDT=IDRWDT+.0001
|
|---|
| 54 | S GMIDT=IDRWDT
|
|---|
| 55 | S ^TMP("LRS",$J,GMTSI,GMIDT)=DRWDT_U_$E(SPEC,1,10)_U_TNM_U_RESULT_U_FLAG_U_UNIT_U_LO_U_HI
|
|---|
| 56 | I $D(^LR(LRDFN,"CH",IDRWDT,1,0)) D
|
|---|
| 57 | . S COM=0
|
|---|
| 58 | . F GMI=1:1 S COM=$O(^LR(LRDFN,"CH",IDRWDT,1,COM)) Q:+COM'>0 S ^TMP("LRS",$J,"C",GMIDT,GMI)=^LR(LRDFN,"CH",IDRWDT,1,COM,0)
|
|---|
| 59 | Q
|
|---|
