| 1 | LR7OU1 ;slc/dcm - General Utilities ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,187,235**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | EN(TST,SUB) ;Expand a lab panel
|
|---|
| 5 | ;TST=Test ptr to file 60
|
|---|
| 6 | ;SUB=Test subscript $p(^LAB(60,X,0),"^",5)
|
|---|
| 7 | ;TSTY(subscript)=TST Expanded panel put in this array
|
|---|
| 8 | N S2,J,X
|
|---|
| 9 | I $L($G(SUB)) S S2=$P(SUB,";",2) S:'$D(TSTY(S2)) TSTY(S2)=+TST Q
|
|---|
| 10 | S J=0 F S J=$O(^LAB(60,+TST,2,J)) Q:J<1 S X=^(J,0) D EN(+X,$P(^LAB(60,+X,0),"^",5))
|
|---|
| 11 | Q
|
|---|
| 12 | TEST ;Test expanding panel
|
|---|
| 13 | S DIC=60,DIC(0)="ZAEQM" D ^DIC Q:Y<1
|
|---|
| 14 | N TSTY D EN(+Y,$P(Y(0),"^",5))
|
|---|
| 15 | ;ZW TSTY
|
|---|
| 16 | Q
|
|---|
| 17 | UPPER(X) ; Convert lower case X to UPPER CASE
|
|---|
| 18 | Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 19 | WC(PK,IFN) ;Get collection type for print fields
|
|---|
| 20 | N X
|
|---|
| 21 | S X=$$TYPE($P(PK,";",2),$P(PK,";",3)),Y=$S(X="WC":"Ward Collect",X="LC":"Lab Collect",X="SP":"Send Patient",X="I":"Immediate Collect",1:"")
|
|---|
| 22 | Q Y
|
|---|
| 23 | ACC(PK,IFN) ;Get accession numbers for print fields
|
|---|
| 24 | N X,Y
|
|---|
| 25 | S X=$$GETST($P(PK,";",2),$P(PK,";",3),IFN),Y="",Y=$P(X,"^",3,5),X=$S($D(^LRO(68,+$P(Y,"^",2),0)):$P(^(0),"^",11),1:""),X=X_" "_$E($P(Y,"^"),4,7)_" "_$P(Y,"^",3)
|
|---|
| 26 | Q X
|
|---|
| 27 | LU(PK,IFN) ;Get urgency for print fields
|
|---|
| 28 | N X
|
|---|
| 29 | S X=$$GETST($P(PK,";",2),$P(PK,";",3),IFN),X=$P(X,"^",2),X=$S(X:$P(^LAB(62.05,X,0),"^"),1:"")
|
|---|
| 30 | Q X
|
|---|
| 31 | COL(PK,IFN) ;Get collection sample with Tube type for print fields
|
|---|
| 32 | N X,Y
|
|---|
| 33 | S X=$$SAMP($P(PK,";",2),$P(PK,";",3))
|
|---|
| 34 | S Y=$S(X:$S($D(^LAB(62,X,0)):$P(^(0),"^")_" "_$P(^(0),"^",3),1:""),1:"")
|
|---|
| 35 | Q Y
|
|---|
| 36 | VER() ;Check OE/RR version #
|
|---|
| 37 | ;Returns current OE/RR version #
|
|---|
| 38 | N VER S VER=$S(+$G(^DD(100,0,"VR")):+^("VR"),1:0)
|
|---|
| 39 | Q VER
|
|---|
| 40 | GETTEST(IFN) ;Get Lab test from Order entry
|
|---|
| 41 | ;IFN=Order # from file 100
|
|---|
| 42 | Q:'$G(IFN) ""
|
|---|
| 43 | N X
|
|---|
| 44 | S X=$$VALUE^ORCSAVE2(IFN,"ORDERABLE") Q:'X ""
|
|---|
| 45 | S X=+$P($G(^ORD(101.43,+X,0)),"^",2)
|
|---|
| 46 | Q X
|
|---|
| 47 | GETST(ODT,SN,IFN) ;Find test node from LRODT,LRSN for a given ORIFN
|
|---|
| 48 | ;ODT=LRODT, SN=LRSN, IFN=ORIFN
|
|---|
| 49 | Q:'$G(ODT) "" Q:'$G(SN) "" Q:'$G(IFN) ""
|
|---|
| 50 | Q:'$D(^LRO(69,ODT,1,SN,0)) ""
|
|---|
| 51 | N TST,X,T,END
|
|---|
| 52 | S X="",(T,END)=0,TST=$$GETTEST(IFN) Q:'TST ""
|
|---|
| 53 | F S T=$O(^LRO(69,ODT,1,SN,2,T)) Q:T<1!(END) D
|
|---|
| 54 | . I $D(^LRO(69,ODT,1,SN,2,T,0)),+^(0)=TST S X=^(0),END=1 Q
|
|---|
| 55 | Q X
|
|---|
| 56 | GET0(ODT,SN) ;Get zero node: ^LRO(69,ODT,1,SN,0) for an ORIFN
|
|---|
| 57 | ;ODT=LRODT, SN=LRSN
|
|---|
| 58 | Q:'$G(ODT) "" Q:'$G(SN) ""
|
|---|
| 59 | Q $G(^LRO(69,ODT,1,SN,0))
|
|---|
| 60 | SAMP(ODT,SN) ;Get collection sample pointer from lab order
|
|---|
| 61 | ;ODT=LRODT, SN=LRSN
|
|---|
| 62 | Q $P($$GET0(ODT,SN),"^",3)
|
|---|
| 63 | TYPE(ODT,SN) ;Get collection type internal value from lab order
|
|---|
| 64 | ;ODT=LRODT, SN=LRSN
|
|---|
| 65 | Q $P($$GET0(ODT,SN),"^",4)
|
|---|
| 66 | SAMPCOM(PK,IFN) ;Get Ward Remarks (specimen) for lab order
|
|---|
| 67 | N TEST,SPEC
|
|---|
| 68 | S TEST=+$$GETST($P(PK,";",2),$P(PK,";",3),IFN) I 'TEST Q ""
|
|---|
| 69 | S SPEC=$$SAMP($P(PK,";",2),$P(PK,";",3)) I 'SPEC Q ""
|
|---|
| 70 | S SPEC=$O(^LAB(60,TEST,3,"B",SPEC,0)) I 'SPEC Q ""
|
|---|
| 71 | Q "^LAB(60,"_TEST_",3,"_SPEC_",1)"
|
|---|
| 72 | WARDCOM(PK,IFN) ;Get General Ward comments on a test order
|
|---|
| 73 | N TEST
|
|---|
| 74 | S TEST=+$$GETST($P(PK,";",2),$P(PK,";",3),IFN) I 'TEST Q ""
|
|---|
| 75 | Q "^LAB(60,"_TEST_",6)"
|
|---|
| 76 | EXPAND(TEST,ARAY) ;Expand a lab test panel
|
|---|
| 77 | ;TEST=Test ptr to file 60
|
|---|
| 78 | ;Expanded panel returned in ARAY(TEST)
|
|---|
| 79 | N INARAY
|
|---|
| 80 | D EX(TEST)
|
|---|
| 81 | M ARAY=INARAY
|
|---|
| 82 | Q
|
|---|
| 83 | EX(TST) ;
|
|---|
| 84 | N J,X,SUB
|
|---|
| 85 | Q:'$D(^LAB(60,TST,0)) S SUB=$P(^(0),"^",5)
|
|---|
| 86 | I $L(SUB) S:'$D(INARAY(+TST)) INARAY(+TST)="" Q
|
|---|
| 87 | S J=0 F S J=$O(^LAB(60,+TST,2,J)) Q:J<1 S X=^(J,0) D EX(+X)
|
|---|
| 88 | Q
|
|---|
| 89 | SPLIT(TXT,ARAY,CTR,LENGTH,PRE,POST) ;Splits text into an array
|
|---|
| 90 | ;Splits text at nearest space from LENGTH value
|
|---|
| 91 | ;Word limit: 150 characters...<150 stored on own node, >150 split
|
|---|
| 92 | ;TXT- text to be split
|
|---|
| 93 | ;ARAY- array to put the text (e.g. "LOCAL", "^TMP(""LRT"",$J)")
|
|---|
| 94 | ;CTR- starting point in array, default=0. Passed by reference so that external counter is incremented.
|
|---|
| 95 | ;LENGTH- length for each array node, default=80
|
|---|
| 96 | ;PRE- optional text to append at the beginning of each array node
|
|---|
| 97 | ;POST- optional text to append at the end of each array node
|
|---|
| 98 | N END
|
|---|
| 99 | Q:'$L($G(TXT)) Q:'$L($G(ARAY))
|
|---|
| 100 | S:'$G(CTR) CTR=0
|
|---|
| 101 | S:'$G(LENGTH) LENGTH=80
|
|---|
| 102 | S:'$L($G(PRE)) PRE=""
|
|---|
| 103 | S:'$L($G(POST)) POST=""
|
|---|
| 104 | I $L(TXT)'>LENGTH!('$F(TXT," ",LENGTH)),$L(TXT)<150 S CTR=CTR+1,@ARAY@(CTR)=PRE_$$STRIP(TXT)_POST Q
|
|---|
| 105 | S END=$S($F(TXT," ",LENGTH):$F(TXT," ",LENGTH),1:LENGTH)
|
|---|
| 106 | S:END>150 END=150
|
|---|
| 107 | S CTR=CTR+1,@ARAY@(CTR)=PRE_$$STRIP($E(TXT,1,$S(END=LENGTH:END,1:END-1)))_POST
|
|---|
| 108 | D SPLIT($E(TXT,END,999),ARAY,.CTR,LENGTH,PRE,POST)
|
|---|
| 109 | Q
|
|---|
| 110 | STRIP(X) ; -- Strip leading spaces from text X
|
|---|
| 111 | N I,Y S Y=""
|
|---|
| 112 | F I=1:1:$L(X) I $E(X,I)'=" " S Y=$E(X,I,999) Q
|
|---|
| 113 | Q Y
|
|---|
