- GMTSLRSE ; SLC/JER,KER - Selected Lab Test Extract ; 09/21/2001
- ;;2.7;Health Summary;**28,36,47**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 67 ^LAB(60
- ; DBIA 524 ^LAB(61
- ; DBIA 525 ^LR(
- ;
- XTRCT ; Extract Selected Lab Test
- ;
- ; Call with LRDFN lab patient
- ; GMTS1 begin date
- ; GMTS2 end date
- ; MAX occurence limit
- ; SEX "M" or "F"
- ; TEST IFN to ^LAB(60)
- ; RWIDTH optional
- ;
- ; Returns ^TMP("LRS",$J,GMTSI,IDRWDT)=
- ; DRWDT^SPEC^TEST^RESULT^FLAG^UNIT^LO^HI
- ;
- ; Where GMTSI=Order (1 to MAX)
- ; IDRWDT=9999999-Draw Date/time
- ; DRWDT=Draw Date/Time (internal)
- ; SPEC=Specimen (int;ext)
- ; TEST=Test (int;ext)
- ; RESULT=Numeric Result
- ; FLAG=Reference flag (H,*H,L,*L)
- ; UNIT=Unit of measure (ext)
- ; LO=Reference/Therapeutic Lower bound
- ; HI=Ref/Ther Upper Bound
- ;
- 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
- D DEM^GMTSU S AGE=GMTSAGE S CNT=0 D CHEM:$P(^LAB(60,TEST,0),U,4)="CH"
- Q
- CHEM ; Gets all Chemistry tests w/in time/occurrence constraints
- N PTR,IDRWDT S PTR=+$P($P(^LAB(60,+TEST,0),U,5),";",2),IDRWDT=GMTS1
- 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
- Q
- CHSET ; Sets Chemistry locals for printing
- N RESULT,FLAG,DRWDT,SITE,SPEC,TNM,DESCR,THER,UNIT,HI,LO,GMIDT
- S RESULT=$P(^LR(LRDFN,"CH",IDRWDT,PTR),U),FLAG=$P(^(PTR),U,2),DRWDT=9999999-IDRWDT
- S RESULT=$$RESULT^GMTSLRCE(TEST,RESULT,$G(RWIDTH))
- S X=DRWDT D REGDTM4^GMTSU S DRWDT=X K X
- S SITE=$P(^LR(LRDFN,"CH",IDRWDT,0),U,5),SPEC=SITE_";"_$P(^LAB(61,SITE,0),U)
- S TNM=TEST_";"_$S($L($P(^LAB(60,TEST,0),U))<21:$P(^(0),U),1:$P(^(.1),U))
- S DESCR=$S($D(^LAB(60,TEST,1,SITE,0)):^(0),1:""),THER=$S($L($P(DESCR,U,11,12))>1:1,1:0)
- 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))
- S @("LO="_$S($L(LO):LO,1:"""""")),@("HI="_$S($L(HI):HI,1:""""""))
- I $D(^TMP("LRS",$J,GMTSI,IDRWDT)) S GMIDT=IDRWDT+.0001
- S GMIDT=IDRWDT
- S ^TMP("LRS",$J,GMTSI,GMIDT)=DRWDT_U_$E(SPEC,1,10)_U_TNM_U_RESULT_U_FLAG_U_UNIT_U_LO_U_HI
- I $D(^LR(LRDFN,"CH",IDRWDT,1,0)) D
- . S COM=0
- . 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)
- Q
- GMTSLRSE ; SLC/JER,KER - Selected Lab Test Extract ; 09/21/2001
- +1 ;;2.7;Health Summary;**28,36,47**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 67 ^LAB(60
- +5 ; DBIA 524 ^LAB(61
- +6 ; DBIA 525 ^LR(
- +7 ;
- XTRCT ; Extract Selected Lab Test
- +1 ;
- +2 ; Call with LRDFN lab patient
- +3 ; GMTS1 begin date
- +4 ; GMTS2 end date
- +5 ; MAX occurence limit
- +6 ; SEX "M" or "F"
- +7 ; TEST IFN to ^LAB(60)
- +8 ; RWIDTH optional
- +9 ;
- +10 ; Returns ^TMP("LRS",$J,GMTSI,IDRWDT)=
- +11 ; DRWDT^SPEC^TEST^RESULT^FLAG^UNIT^LO^HI
- +12 ;
- +13 ; Where GMTSI=Order (1 to MAX)
- +14 ; IDRWDT=9999999-Draw Date/time
- +15 ; DRWDT=Draw Date/Time (internal)
- +16 ; SPEC=Specimen (int;ext)
- +17 ; TEST=Test (int;ext)
- +18 ; RESULT=Numeric Result
- +19 ; FLAG=Reference flag (H,*H,L,*L)
- +20 ; UNIT=Unit of measure (ext)
- +21 ; LO=Reference/Therapeutic Lower bound
- +22 ; HI=Ref/Ther Upper Bound
- +23 ;
- +24 NEW CNT,AGE,COM,GMI,X
- KILL ^TMP("LRS",$JOB,GMTSI)
- IF $SELECT("BO"'[$PIECE(^LAB(60,TEST,0),U,3):1,1:0)
- QUIT
- +25 DO DEM^GMTSU
- SET AGE=GMTSAGE
- SET CNT=0
- IF $PIECE(^LAB(60,TEST,0),U,4)="CH"
- DO CHEM
- +26 QUIT
- CHEM ; Gets all Chemistry tests w/in time/occurrence constraints
- +1 NEW PTR,IDRWDT
- SET PTR=+$PIECE($PIECE(^LAB(60,+TEST,0),U,5),";",2)
- SET IDRWDT=GMTS1
- +2 FOR
- SET IDRWDT=$ORDER(^LR(LRDFN,"CH",IDRWDT))
- IF 'IDRWDT!(IDRWDT>GMTS2)!(CNT'<MAX)
- QUIT
- IF $PIECE(^(IDRWDT,0),U,3)
- IF ($DATA(^(PTR)))
- SET CNT=CNT+1
- IF CNT'>MAX
- DO CHSET
- +3 QUIT
- CHSET ; Sets Chemistry locals for printing
- +1 NEW RESULT,FLAG,DRWDT,SITE,SPEC,TNM,DESCR,THER,UNIT,HI,LO,GMIDT
- +2 SET RESULT=$PIECE(^LR(LRDFN,"CH",IDRWDT,PTR),U)
- SET FLAG=$PIECE(^(PTR),U,2)
- SET DRWDT=9999999-IDRWDT
- +3 SET RESULT=$$RESULT^GMTSLRCE(TEST,RESULT,$GET(RWIDTH))
- +4 SET X=DRWDT
- DO REGDTM4^GMTSU
- SET DRWDT=X
- KILL X
- +5 SET SITE=$PIECE(^LR(LRDFN,"CH",IDRWDT,0),U,5)
- SET SPEC=SITE_";"_$PIECE(^LAB(61,SITE,0),U)
- +6 SET TNM=TEST_";"_$SELECT($LENGTH($PIECE(^LAB(60,TEST,0),U))<21:$PIECE(^(0),U),1:$PIECE(^(.1),U))
- +7 SET DESCR=$SELECT($DATA(^LAB(60,TEST,1,SITE,0)):^(0),1:"")
- SET THER=$SELECT($LENGTH($PIECE(DESCR,U,11,12))>1:1,1:0)
- +8 SET UNIT=$PIECE(DESCR,U,7)
- SET LO=$SELECT(THER:$PIECE(DESCR,U,11),1:$PIECE(DESCR,U,2))
- SET HI=$SELECT(THER:$PIECE(DESCR,U,12),1:$PIECE(DESCR,U,3))
- +9 SET @("LO="_$SELECT($LENGTH(LO):LO,1:""""""))
- SET @("HI="_$SELECT($LENGTH(HI):HI,1:""""""))
- +10 IF $DATA(^TMP("LRS",$JOB,GMTSI,IDRWDT))
- SET GMIDT=IDRWDT+.0001
- +11 SET GMIDT=IDRWDT
- +12 SET ^TMP("LRS",$JOB,GMTSI,GMIDT)=DRWDT_U_$EXTRACT(SPEC,1,10)_U_TNM_U_RESULT_U_FLAG_U_UNIT_U_LO_U_HI
- +13 IF $DATA(^LR(LRDFN,"CH",IDRWDT,1,0))
- Begin DoDot:1
- +14 SET COM=0
- +15 FOR GMI=1:1
- SET COM=$ORDER(^LR(LRDFN,"CH",IDRWDT,1,COM))
- IF +COM'>0
- QUIT
- SET ^TMP("LRS",$JOB,"C",GMIDT,GMI)=^LR(LRDFN,"CH",IDRWDT,1,COM,0)
- End DoDot:1
- +16 QUIT
