| 1 | LR7OR3 ;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
|
---|
| 6 | GET(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
|
---|
| 11 | TEST(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
|
---|
| 31 | COLL(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
|
---|
| 46 | URG(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
|
---|
| 55 | SAMP(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
|
---|
| 65 | DEFURG() ;Get default urgency for lab
|
---|
| 66 | Q $P($G(^LAB(69.9,1,3)),U,2)
|
---|
| 67 | SCOM(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
|
---|
| 75 | GCOM(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
|
---|