source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRCE.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMTSLRCE ; SLC/JER,KER - Chemistry Extract Routine ; 08/27/2002
2 ;;2.7;Health Summary;**18,28,29,56,79**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 67 ^LAB(60
6 ; DBIA 524 ^LAB(61
7 ; DBIA 525 ^LR(
8 ; DBIA 10103 $$FMTHL7^XLFDT
9 ;
10XTRCT ; Extract
11 ;
12 ; Call with LRDFN, GMTS1, GMTS2,
13 ; MAX (#occurrences) and SEX (M or F)
14 ;
15 N IDT,CNT,AGE D:'$D(GMTSAGE) DEM^GMTSU S AGE=GMTSAGE K ^TMP("LRC",$J)
16 S IDT=GMTS1,CNT=0 F S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT=""!(IDT>GMTS2) D:CNT'>MAX CHSET
17 Q
18CHSET ; Sets Chemistry locals for printing
19 N CDT,SITE,SPEC,PTR,ISVALID,GMI,ACC,LOC,COM,RDT,SNOMED
20 S ISVALID=$P(^LR(LRDFN,"CH",IDT,0),U,3) Q:ISVALID="" S SNOMED=""
21 S CDT=+^LR(LRDFN,"CH",IDT,0),SITE=$P(^(0),U,5),SPEC=$P(^LAB(61,SITE,0),U),SNOMED=$P(^(0),U,2),CNT=CNT+1
22 I $D(EXPAND) D
23 . S SPEC=SNOMED_";"_SPEC,RDT=$P(^LR(LRDFN,"CH",IDT,0),U,3)
24 . S ACC=$P(^(0),U,6),ACC=$P(ACC," ",2,3)_" "_$P(ACC," ")
25 . S LOC=$P(^(0),U,11)
26 . S RDT=$$FMTHL7^XLFDT(RDT)
27 S X=CDT D REGDTM4^GMTSU:'$D(EXPAND)
28 S:$D(EXPAND) X=$$FMTHL7^XLFDT(X) S CDT=X K X
29 S PTR=1 F S PTR=$O(^LR(LRDFN,"CH",IDT,PTR)) Q:PTR<1 D NXTST
30 I $D(^LR(LRDFN,"CH",IDT,1,0)),($D(^TMP("LRC",$J,IDT))) D
31 . S COM=0 F GMI=1:1 S COM=$O(^LR(LRDFN,"CH",IDT,1,COM)) Q:+COM'>0 S ^TMP("LRC",$J,IDT,"C",GMI)=^LR(LRDFN,"CH",IDT,1,COM,0)
32 Q
33NXTST ; Visit next node in ^(PTR) subtree
34 N RESULT,FLAG,TEST,GMPC,GMSQN,TNM,DESCR,THER,UNIT,HI,LO,CIS,GMTSLRES
35 S GMTSLRES=$$TSTRES^LRRPU(LRDFN,"CH",IDT,PTR)
36 ; S RESULT=$P(^LR(LRDFN,"CH",IDT,PTR),U),FLAG=$P(^(PTR),U,2),CIS=""
37 S RESULT=$P(GMTSLRES,U,1),FLAG=$P(GMTSLRES,U,2),CIS=""
38 I $D(EXPAND),(FLAG["*") S FLAG=$S(FLAG="L*":"LL",FLAG="H*":"HH",1:FLAG)
39 S TEST=$O(^LAB(60,"C","CH;"_PTR_";1",0)) Q:TEST'>0
40 S TNM=$S($L($P(^LAB(60,TEST,0),U))<19:$P(^(0),U),1:$P(^(.1),U))
41 ; Quit if Test Type is neither "Output" or "Both"
42 I $S("BO"'[$P(^LAB(60,TEST,0),U,3):1,1:0) Q
43 S GMSQN=$S($P($G(^LAB(60,TEST,.1)),U,6):$P($G(^(.1)),U,6),1:PTR/1000000)
44 I $D(^LAB(60,TEST,10)) S CIS=^(10)
45 I $D(EXPAND),'$L(CIS) Q
46 I $D(EXPAND) S TNM=CIS_";"_TNM
47 ; Execute Print Code from file 60 to evaluate RESULT
48 S RESULT=$$RESULT(TEST,RESULT,$G(RWIDTH))
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(EXPAND),'$L(FLAG),(+$G(HI)'<+$G(RESULT)),(+$G(LO)'>+$G(RESULT)) S FLAG="N"
54 F Q:'$D(^TMP("LRC",$J,IDT,GMSQN)) Q:TEST=+^(GMSQN) S GMSQN=GMSQN+1
55 Q:$D(^TMP("LRC",$J,IDT,GMSQN))
56 S ^TMP("LRC",$J,IDT,GMSQN)=CDT_U_SPEC_U_TNM_U_RESULT_U_FLAG_U_UNIT_U_LO_U_HI
57 I $D(EXPAND) D XPND
58 Q
59XPND ; Appends additional data if required
60 S ^TMP("LRC",$J,IDT,GMSQN)=^TMP("LRC",$J,IDT,GMSQN)_U_ACC_U_RDT_U_LOC
61 Q
62 ;
63RESULT(TEST,RESULT,LRCW) ; Convert result to external format
64 ;
65 ; Where
66 ; TEST=Test ptr to file 60
67 ; RESULT=Test result
68 ; LRCW=Optional width of variable. Default is 0
69 N X,X1
70 I +$G(LRCW)'>0 S LRCW=0
71 S X1=$P($G(^LAB(60,TEST,.1)),"^",3),X1=$S($L(X1):X1,1:"$J(X,LRCW)"),X=RESULT,@("X="_X1)
72 Q X
Note: See TracBrowser for help on using the repository browser.