source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSOS1.m@ 1005

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1LR7OSOS1 ;slc/dcm - Lab order status for OE/RR ;8/11/97
2 ;;5.2;LAB SERVICE;**229**;Sep 27, 1994
3EN(OMEGA,ALPHA) ;
4 N LRODT,LRSN,LREND
5 S LRODT=$S($G(ALPHA):ALPHA,1:""),LREND=0
6 F S LRODT=$O(^LRO(69,"D",LRDFN,LRODT),-1) Q:LRODT<1!(LRODT<OMEGA) D ENTRY Q:LREND
7 Q
8ENTRY D HED
9 S LRSN=0
10 F S LRSN=$O(^LRO(69,"D",LRDFN,LRODT,LRSN)) Q:LRSN<1 D ORDER,HED:$Y>(GIOSL-3) Q:LREND
11 Q
12ORDER ;call with LRODT,LRSN
13 N LROD0,LROD1,LROD3,X,LRDOC,X4,I,LRACN,LRACN0
14 K D,LRTT
15 Q:'$D(^LRO(69,LRODT,1,LRSN,0))
16 S LROD0=^LRO(69,LRODT,1,LRSN,0),LROD1=$S($D(^(1)):^(1),1:""),LROD3=$S($D(^(3)):^(3),1:"")
17 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(2,CCNT,"Lab Order # "_$S($D(^LRO(69,LRODT,1,LRSN,.1)):^(.1),1:""))
18 S X=$P(LROD0,U,6)
19 D DOC^LRX
20 S ^(0)=^TMP("ORDATA",$J,1,GCNT,0)_$$S^LR7OS(45,CCNT,"Provider: "_$E(LRDOC,1,25))
21 S X=$P(LROD0,U,3),X=$S(X:$S($D(^LAB(62,+X,0)):$P(^(0),U),1:""),1:""),X4=""
22 I $D(^LRO(69,LRODT,1,LRSN,4,1,0)),+^(0) S X4=+^(0),X4=$S($D(^LAB(61,X4,0)):$P(^(0),U),1:"")
23 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(2,CCNT,X_" ")
24 I X'[X4 S ^(0)=^TMP("ORDATA",$J,1,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X4)
25 S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 D LN S X=^(I,0),^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(5,CCNT,": "_X)
26 S LRACN=0 F S LRACN=$O(^LRO(69,LRODT,1,LRSN,2,LRACN)) Q:LRACN<1 I $D(^(LRACN,0))#2 S LRACN0=^(0) D TEST
27 Q
28TEST ;
29 N LRY,LRURG,LRROD,Y,LRLL,LROT,LROS,LROOS,LROSD,LRURG,X3,X,X1,X2,LRACD,LRACC,LRTSTS
30 S LRROD=$P(LRACN0,U,6),(Y,LRLL,LROT,LROS,LROSD,LRURG)="",X3=0
31 I $P(LRACN0,"^",11) G CANC
32 S X=$P(LROD0,U,4),LROT=$S(X="WC":"Requested (WARD COL)",X="SP":"Requested (SEND PATIENT)",X="LC":"Requested (LAB COL)",X="I":"Requested (IMM LAB COL)",1:"undetermined")
33 S X=$P(LROD1,U,4),(LROOS,LROS)=$S(X="C":"Collected",X="U":"Uncollected, cancelled",1:"On Collection List")
34 S:X="C" LROT=""
35 I '(+LRACN0) D LINE,LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(1,CCNT,"BAD ORDER "_LRSN) D LINE Q
36 G NOTACC:LROD1=""
37TST1 S X1=+$P(LRACN0,U,4),X2=+$P(LRACN0,U,3),X3=+$P(LRACN0,U,5)
38 G NOTACC:'$D(^LRO(68,X1,1,X2,1,X3,0)),NOTACC:'$D(^(3)) S LRACD=$S($D(^(9)):^(9),1:"")
39 I '$D(LRTT(X1,X2,X3)) S LRTT(X1,X2,X3)="",I=0 F S I=$O(^LRO(68,X1,1,X2,1,X3,4,I)) Q:I<.5 S LRACC=^(I,0),LRTSTS=+LRACC D TST2
40 I $L($P(LROD1,U,6)) D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(20,CCNT,$P(LROD1,U,6))
41 Q
42TST2 ;
43 N I,LRURG,LROT,LROS,LRLL,Y,LROSD
44 S LRURG=+$P(LRACC,U,2)
45 I LRURG>49 Q
46 I 'LRTSTS D LINE,LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(1,CCNT,"BAD ACCESSION TEST POINTER: "_LRTSTS) Q
47 S LROT="",LROS=LROOS,LRLL=$P(LRACC,U,3),Y=$P(LRACC,U,5)
48 I Y S LROS="Test Complete" D DATE S LROSD=Y D WRITE,COM(1) Q
49 S Y=$P(LROD3,U)
50 D DATE
51 S LROSD=Y
52 I LRLL S LROS="Testing In Progress"
53 I $P(LROD1,"^",4)="U" S (LROS,LROOS)=""
54 D WRITE,COM(1)
55 Q
56WRITE ;
57 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(2,CCNT,$S($D(^LAB(60,+LRTSTS,0)):$P(^(0),U),1:"BAD TEST POINTER"))
58 I CCNT>20 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=""
59 S ^TMP("ORDATA",$J,1,GCNT,0)=^TMP("ORDATA",$J,1,GCNT,0)_$$S^LR7OS(20,CCNT,$S($D(^LAB(62.05,+LRURG,0)):$P(^(0),U),1:"")_" ")
60 I CCNT>28 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=""
61 S ^(0)=^TMP("ORDATA",$J,1,GCNT,0)_$$S^LR7OS(28,CCNT,LROT_" "_LROS)_$$S^LR7OS(48,CCNT,LROSD)
62 I X3 S ^TMP("ORDATA",$J,1,GCNT,0)=^TMP("ORDATA",$J,1,GCNT,0)_$$S^LR7OS(62,CCNT," "_$S($D(^LRO(68,X1,1,X2,1,X3,.2)):^(.2),1:""))
63 I LRROD D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(46,CCNT," See order: "_LRROD)
64 Q
65COM(COMNODE) ;Write comment
66 ;COMNODE=Comment node to write
67 S:'$G(COMNODE) COMNODE=1
68 I LRTSTS=+LRACN0 S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,LRACN,COMNODE,I)) Q:I<1 D LN S X=^(I,0),^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(3,CCNT,": "_X)
69 Q
70NOTACC I LROD3="" S LROS="" G NO2
71 I $P(LROD3,U,2)'="" S LROS=" ",Y=$P(LROD3,U,2) G NO2
72 S Y=$P(LROD3,U) S LROS=" "
73NO2 ;
74 S:'Y Y=$P(LROD0,U,8)
75 S Y=$S(Y:Y,+LROD3:+LROD3,+LROD1:+LROD1,1:LRODT)
76 D DATE
77 S LROSD=Y,LRTSTS=+LRACN0,LRURG=$P(LRACN0,U,2),LROS=$S(LRROD:"Combined",1:LROS)
78 S:LROS="" LROS="for: "
79 D WRITE:LRTSTS,COM(1)
80 I $L($P(LROD1,U,6)) D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(20,CCNT,$P(LROD1,U,6))
81 Q
82DATE S Y=$$FMTE^XLFDT($P(Y,"."),"5Z")_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"") Q
83HED ;
84 I $O(^LRO(69,"D",LRDFN,LRODT,0)) D LINE,LN S Y=LRODT D DD^LRX S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(1,CCNT,"Orders for date: "_Y)
85 D LN S ^TMP("ORDATA",$J,1,GCNT,0)=$$S^LR7OS(1,CCNT," Test")_$$S^LR7OS(20,CCNT,"Urgency")_$$S^LR7OS(30,CCNT,"Status")_$$S^LR7OS(64,CCNT,"Accession")
86 Q
87CANC ;For Canceled tests
88 N LRTSTS
89 S LRTSTS=+LRACN0,LROT="Canceled by: "_$P(^VA(200,$P(LRACN0,"^",11),0),"^")
90 D WRITE:LRTSTS,COM(1.1),COM(1) ;second call for backward compatibility - can be removed in future years (1/98)
91 Q
92TST ;Test call
93 D EN1(.Y,"38;DPT(",2981101,$$NOW^XLFDT)
94 Q
95EN1(Y,ORVP,START,END,DTRANGE) ;Broker compatible entry point
96 S Y=$NA(^TMP("ORDATA",$J,1))
97 Q:'$G(ORVP)
98 I $L($G(DTRANGE)),'$G(START) S START=$$FMADD^XLFDT(DT,-DTRANGE),END=$$NOW^XLFDT
99 S:'$G(START) START=0
100 S:'$G(END) END=$$NOW^XLFDT
101 N GIOSL,GIOM,GCNT,CCNT,DFN,LRDFN,LRDPF,LRDT0,VA200
102 S GIOSL=9999999,GIOM=80,GCNT=0,CCNT=1
103 K ^TMP("ORDATA",$J)
104 S DFN=+ORVP,LRDPF=+$P(@("^"_$P(ORVP,";",2)_"0)"),"^",2)_"^"_$P(ORVP,";",2),LRDFN=$$LRDFN^LR7OR1(DFN)
105 I 'LRDFN S Y=$NA(^TMP("ORDATA",$J,1)) Q
106 D EN(START,END)
107 S Y=$NA(^TMP("ORDATA",$J,1))
108 Q
109LN ;Increment counts
110 S GCNT=GCNT+1,CCNT=1
111 Q
112OUT ;Show output
113 Q:'$D(^TMP("ORDATA",$J))
114 N I
115 S I=0
116 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:'I W !,^(I,0)
117 Q
118LINE ;Fill in the global with blank lines
119 N X
120 D LN S X="",$P(X," ",GIOM)="",^TMP("ORDATA",$J,1,GCNT,0)=X
121 Q
Note: See TracBrowser for help on using the repository browser.