source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OGMP.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ; Mar 10, 2003
2 ;;5.2;LAB SERVICE;**187,246,282,286,344**;Sep 27, 1994
3 ;
4PRINT(OUTCNT) ; from LR7OGMC
5 N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,HIGH,IDT,INTP,LINE,LOW,LRCW,LRX,PORDER,PRNTCODE,RANGE,REFHIGH,REFLOW,SEX,SITE,SPEC,SUB,TESTNUM
6 N TESTSPEC,THER,THERHIGH,THERLOW,UNITS,VALUE,X,ZERO
7 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
8 S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
9 S CDT=0
10 F S CDT=$O(^TMP("LR7OG",$J,"TP",CDT)) Q:CDT="" D
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(+$P(ZERO,U,10))
16 . D SETLINE("",.OUTCNT)
17 . D SETLINE("Provider : "_DOC,.OUTCNT)
18 . S LINE=" Specimen: "_$P(^LAB(61,SPEC,0),U)_"."
19 . S ACC=$P(ZERO,U,6)
20 . S LINE=$$SETSTR^VALM1(" "_ACC,LINE,30,1+$L(ACC))
21 . D SETLINE(LINE,.OUTCNT)
22 . D SETLINE(" "_$$DD(CDT),.OUTCNT)
23 . D SETLINE(" Test name Result units Ref. range Site Code",.OUTCNT)
24 . S PORDER=0
25 . F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
26 .. I $P(DATA,U,7)="" Q
27 .. S TESTNUM=+DATA,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),SITE=$P(DATA,U,11)
28 .. S LOW=$P(RANGE,"-"),HIGH=$P(RANGE,"-",2),THER=$P(DATA,U,12)
29 .. S LINE=" "_$S($L($P(DATA,U,2))>20:$P(DATA,U,3),1:$P(DATA,U,2))
30 .. S LINE=$$SETSTR^VALM1("",LINE,28,0)
31 .. I PRNTCODE="" S LINE=LINE_$J(X,8)
32 .. E S @("VALUE="_PRNTCODE),LINE=LINE_VALUE
33 .. S LINE=LINE_" "_FLAG
34 .. I $L(LINE)>38 D SETLINE(LINE,.OUTCNT) S LINE=""
35 .. I UNITS'="" S LINE=$$SETSTR^VALM1(" "_UNITS,LINE,39,2+$L(UNITS))
36 .. S LRX=RANGE
37 .. I LRX'="" S LINE=$$SETSTR^VALM1(LRX,LINE,52,$L(LRX))
38 .. I $L(LINE)>67,SITE D SETLINE(LINE,.OUTCNT) S LINE=""
39 .. I SITE S LINE=$$SETSTR^VALM1(" ["_SITE_"]",LINE,68,3+$L(SITE))
40 .. I LINE'="" D SETLINE(LINE,.OUTCNT)
41 .. I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
42 ... S INTP=0
43 ... F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D SETLINE(" Eval: "_^(INTP),.OUTCNT)
44 . I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
45 .. S LINE="Comment: "
46 .. S CMNT=0
47 .. F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=LINE_^(CMNT) D
48 ... D SETLINE(LINE,.OUTCNT)
49 ... I $O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) S LINE=" "
50 . D SETLINE("===============================================================================",.OUTCNT)
51 Q
52 ;
53 ;
54SETLINE(LINE,CNT) ;
55 S ^TMP("LR7OGX",$J,"OUTPUT",CNT)=LINE
56 S CNT=CNT+1
57 Q
58 ;
59 ;
60NAME(X) ; $$(#) -> name
61 N LRDOC
62 D DOC^LRX
63 Q LRDOC
64 ;
65 ;
66DD(Y) ; $$(date/time) -> date/time format
67 D DD^LRX
68 Q Y
69 ;
70 ;
71PLS ; List performing laboratories
72 ;
73 N LINE,LRPLS,X
74 D SETLINE("Performing Lab Sites",.OUTCNT)
75 S LRPLS=0
76 F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
77 . S LINE=$$LJ^XLFSTR("["_LRPLS_"] ",8)_$$NAME^XUAF4(LRPLS)
78 . D SETLINE(LINE,.OUTCNT)
79 . S X=$$PADD^XUAF4(LRPLS)
80 . S LINE=$$REPEAT^XLFSTR(" ",8)_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
81 . D SETLINE(LINE,.OUTCNT)
82 ;
83 D SETLINE("===============================================================================",.OUTCNT)
84 ;
85 K ^TMP("LRPLS",$J)
86 Q
Note: See TracBrowser for help on using the repository browser.