source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LR7OGMG.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 3.0 KB
Line 
1LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;July 19, 2006
2 ;;5.2;LAB SERVICE;**187,230,286,290,331**;Sep 27, 1994;Build 7
3 ;
4GRID(OUTCNT) ; from LR7OGMC
5 N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
6 N UNITS,VALUE,X,ZERO
7 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
8 K ^TMP("LRMPLS",$J)
9 S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
10 S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT
11 S IDT=9999999-CDT
12 S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
13 I '$P(ZERO,U,3) Q
14 S SPEC=+$P(ZERO,U,5)
15 S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10))
16 S ACC=$P(ZERO,U,6)
17 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
18 S (TCNT,MPLS,PORDER,PLS)=0
19 S PLS=$O(^TMP("LRPLS",$J,0))
20 I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
21 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
22 . I $P(DATA,U,7)="" Q
23 . S TCNT=TCNT+1
24 . S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),PLS=$P(DATA,U,11)
25 . I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)=""
26 . I PRNTCODE="" S VALUE=$J(X,8)
27 . E S @("VALUE="_PRNTCODE)
28 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
29 . S OUTCNT=OUTCNT+1
30 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT
31 ;
32 S PORDER=0
33 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
34 . I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
35 . . S TESTNAME=$P(DATA,U,3)
36 . . S INTP=0
37 . . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D
38 . . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)
39 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
40 . . . S OUTCNT=OUTCNT+1
41 ;
42 I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
43 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: "
44 . S OUTCNT=OUTCNT+1,CMNT=0
45 . F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D
46 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE
47 . . S OUTCNT=OUTCNT+1
48 ;
49 D PLS
50 Q
51 ;
52 ;
53PLS ; List performing laboratories
54 ; If multiple performing labs then list tests associated with each lab.
55 ;
56 N CNT,LINE,LRPLS,X
57 S (CNT,LRPLS)=0
58 F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
59 . I CNT S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
60 . I $D(^TMP("LRMPLS",$J,LRPLS)) D
61 . . S TESTNAME="",LINE="For test(s): "
62 . . F S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D
63 . . . I ($L(LINE)+$L(TESTNAME))>240 D
64 . . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
65 . . . . S OUTCNT=OUTCNT+1,LINE=""
66 . . . S LINE=LINE_TESTNAME_", "
67 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1
68 . S LINE=$$NAME^XUAF4(LRPLS)
69 . S X=$$PADD^XUAF4(LRPLS)
70 . S LINE=LINE_" "_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
71 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_LINE
72 . S OUTCNT=OUTCNT+1,CNT=CNT+1
73 ;
74 K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J)
75 Q
Note: See TracBrowser for help on using the repository browser.