source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OR3.m@ 810

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1LR7OR3 ;slc/dcm - Get Lab TEST parameters ;8/11/97
2 ;;5.2;LAB SERVICE;**121,187,245,256**;Sep 27, 1994
3 ;Entry points: TEST - to get all TEST parameters
4 ; COLL - to get collection sample & specimen parameters
5 ; URG - to get urgency parameters
6GET(TEST) ;Get TEST ifn
7 I '$D(TEST) Q ""
8 I TEST'?1N.N S TEST=$O(^LAB(60,"B",TEST,0)) Q:'TEST ""
9 I TEST?1N.N Q:'$D(^LAB(60,TEST)) ""
10 Q TEST
11TEST(TEST,Y) ;Gets Lab Test ordering parameters from file 60
12 ;TEST=Lab TEST (can be either name or internal #)
13 ;Y("Unique CollSamp")=n
14 ;Y("Default CollSamp")=n
15 ;Y("Lab CollSamp")=n (Lab Collection Sample)
16 ;Y("Default Urgency")=ptr 62.05^Name
17 ;Y("Urgencies",n)=ptr 62.05^Name
18 ;Y("Specimens",n)=ptr 61^Name
19 ;Y("CollSamp",n)=ptr 62^Name^DefSpecimen^TubeColor^MaxOrd^MaxDay^LabCollect^ReqComID
20 ;Y("CollSamp",n,"WD",i,0)=Ward Remarks
21 ;Y("GenWardInstructions",n)=General Ward Instructions
22 ;Y("ReqCom")=Required Comment ID at Test level
23 N X0
24 Q:'$D(TEST)
25 S TEST=$$GET(TEST) Q:'TEST
26 S X0=^LAB(60,TEST,0)
27 D GCOM(TEST,.Y)
28 D COLL(TEST,.Y)
29 D URG(TEST,.Y)
30 Q
31COLL(TEST,Y) ;Get Collection Sample-Specimen data
32 N X0,I,J,X,SAMP,SPEC
33 Q:'$D(TEST)
34 S TEST=$$GET(TEST)
35 Q:'TEST
36 S X0=^LAB(60,TEST,0),I=0
37 I $P(X0,"^",19) S Y("ReqCom")=$P($G(^LAB(62.07,+$P(X0,"^",19),0)),"^")
38 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=^(I,0),Y("CollSamp",I)=$$SAMP(X),Y("CollSamp")=+$G(Y("CollSamp"))+1,J=0 D
39 . F S J=$O(^LAB(60,TEST,3,I,1,J)) Q:J<1 S Y("CollSamp",I,"WP",J,0)=^(J,0)
40 I $O(^LAB(60,TEST,3,0)) S Y("Default CollSamp")=$O(^(0))
41 S I=0 F S I=$O(^LAB(60,TEST,1,I)) Q:I<1 S X=^(I,0),Y("Specimens",I)=+X_"^"_$P($G(^LAB(61,+X,0)),"^"),Y("Specimens")=+$G(Y("Specimens"))+1
42 I $P(X0,"^",8),$O(^LAB(60,TEST,3,0)) S Y("Unique CollSamp")=+$O(^(0))
43 I $P(X0,"^",9) S I=0 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=+^(I,0) I X=$P(X0,"^",9) S Y("Lab CollSamp")=I Q
44 I $P(X0,"^",9),'$D(Y("Lab CollSamp")) S Y("Lab CollSamp")=999,Y("CollSamp",999)=$$SAMP($P(X0,"^",9)),Y("CollSamp")=+$G(Y("CollSamp"))+1
45 Q
46URG(TEST,Y) ;Get Urgency params for TEST
47 N X0,I,X,URG
48 Q:'$D(TEST)
49 S TEST=$$GET(TEST)
50 Q:'TEST
51 S X0=^LAB(60,TEST,0)
52 I $P(X0,"^",18) S Y("Default Urgency")=$P(X0,"^",18)_"^"_$P($G(^LAB(62.05,+$P(X0,"^",18),0)),"^",1,2) Q
53 S I=0 F S I=$O(^LAB(62.05,I)) Q:I<1!(I>49) I $P(X0,"^",16)'>I S Y("Urgencies",I)=I_"^"_$P(^(I,0),"^",1,2),Y("Urgencies")=+$G(Y("Urgencies"))+1
54 Q
55SAMP(X) ;Build Collection Sample data
56 ;SAMP(X,REQ) ;Build Collection Sample data
57 ;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
58 ;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
59 ;N X0,Y
60 N X0,Y,REQ
61 Q:'$D(^LAB(62,+X,0)) "" S X0=^(0)
62 S REQ=+$P(X,"^",6),REQ=$S(REQ:$P($G(^LAB(62.07,REQ,0)),"^"),1:"")
63 S Y=+X_"^"_$P(X0,"^")_"^"_$P(X0,"^",2)_"^"_$P(X0,"^",3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X0,"^",7)_"^"_REQ
64 Q Y
65DEFURG() ;Get default urgency for lab
66 Q $P($G(^LAB(69.9,1,3)),U,2)
67SCOM(TEST,SAMP,TEXT) ;Get Ward Remarks (specimen) & put in TEXT aray
68 ;TEST=ptr to TEST in file 60
69 ;SAMP=ptr to collection sample file 62
70 N X
71 S X=$O(^LAB(60,+$G(TEST),3,"B",+$G(SAMP),0))
72 Q:'X
73 M TEXT=^LAB(60,TEST,3,X,1)
74 Q
75GCOM(TEST,TEXT) ;Get General Ward Instructions
76 ;TEST=ptr to TEST in file 60
77 Q:'$O(^LAB(60,+$G(TEST),6,0))
78 M TEXT("GenWardInstructions")=^LAB(60,TEST,6)
79 Q
Note: See TracBrowser for help on using the repository browser.