| 1 | LRBLPCS1 ;AVAMC/REG/CYM - COMPONENT SELECTION CK PT SPEC ;7/22/97 08:13 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1,72,90,247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | S (H,M)=0
|
|---|
| 5 | S X=$P(^LAB(66,C,0),"^",16) S:'X X=72 S Z=X*60,X="N",%DT="T" D ^%DT K %DT S X=Y,X(1)=Y_"000" D H^%DTC S %H=%H-(Z\1440),Z=Z#1440 I Z S %H=%H-1,Z=1440-Z,H=Z\60,M=Z#60
|
|---|
| 6 | I 'H,'M S H=$E(X(1),9,10),M=$E(X(1),11,12)
|
|---|
| 7 | D D^LRUT S X=X_"."_$E("00",1,2-$L(H))_H_$E("00",1,2-$L(M))_M,G=9999999-X
|
|---|
| 8 | ; Following 10 lines check spec. age during LRBLPLOGIN
|
|---|
| 9 | I '$D(LRQ) D
|
|---|
| 10 | . K Z S A=0 F B=0:0 S B=$O(^LR(LRDFN,"BB",B)) Q:'B!(B>G) S X=^(B,0),S=$P(X,"^",5) I S=LRBBSPEC,LRABV=$P($P(X,"^",6)," ") S Y=$P(X,"^",10) S:'Y Y=+X S A=A+1,Z(A)=Y_"^"_B_"^"_$P(X,"^",6) Q:$D(LRJ)
|
|---|
| 11 | . I '$D(Z),'$D(LRQ) W $C(7),!?18,"No patient blood sample within required time",!?9,"Obtain a new sample from the patient for compatibility testing",!
|
|---|
| 12 | . S Y="^" Q
|
|---|
| 13 | I $D(LRQ) D
|
|---|
| 14 | . K Z S A=0 F B=0:0 S B=$O(^LR(LRDFN,"BB",B)) Q:'B!(B>G) S X=^(B,0),S=$P(X,"^",5) I S=E,LRABV=$P($P(X,"^",6)," ") S Y=$P(X,"^",10) S:'Y Y=+X S A=A+1,Z(A)=Y_"^"_B_"^"_$P(X,"^",6) Q:$D(LRJ)
|
|---|
| 15 | . Q:'$D(LRCDT)
|
|---|
| 16 | . N LRINVDT S LRINVDT=(9999999-LRCDT)
|
|---|
| 17 | . I LRINVDT>G W $C(7),!,?18,"Log in specimen collection date/time NOT within required time",!,?9,"Obtain a new sample from the patient for compatibility testing",!
|
|---|
| 18 | S Y="^" Q
|
|---|
| 19 | ;
|
|---|
| 20 | EN ;
|
|---|
| 21 | S:'$D(LRAA)#2 LRAA=$O(^LRO(68,"B","BLOOD BANK",0)) Q:'LRAA
|
|---|
| 22 | I LRAA<1 S LRAA=$O(^LRO(68,"B","BLOOD BANK",0)) Q:'LRAA
|
|---|
| 23 | I '$D(^LRO(69.2,LRAA,8,0)) S ^(0)="^69.31A^^"
|
|---|
| 24 | I '$D(^LRO(69.2,LRAA,8,66,0)) S ^(0)=66,X=^LRO(69.2,LRAA,8,0),^(0)="^69.31A^66^"_($P(X,"^",4)+1)
|
|---|
| 25 | L +^LRO(69.2,LRAA,8,66):5 I '$T W $C(7),!!,"I Cannot add this request to the Inappropriate transfusion requests report at this time ",!!,"Please make note ...",!! Q
|
|---|
| 26 | S:'$D(^LRO(69.2,LRAA,8,66,1,0)) ^(0)="^69.32A^^"
|
|---|
| 27 | F A=0:0 S A=$O(LRK(A)) Q:'A I $D(^LR(LRDFN,1.8,A,0)) S X(2)=^(0),A(3)=$P(X(2),"^",3),Y=$P(X(2),"^",5),A(1)=$P(^LAB(66,A,0),"^") D D^LRU,B
|
|---|
| 28 | L -^LRO(69.2,LRAA,8,66) Q
|
|---|
| 29 | B I '$D(^LRO(69.2,LRAA,8,66,1,A,0)) S ^(0)=A(1),X=^LRO(69.2,LRAA,8,66,1,0),^(0)=$P(X,"^",1,2)_"^"_A_"^"_($P(X,"^",4)+1),^LRO(69.2,LRAA,8,66,1,"B",A(1),A)=""
|
|---|
| 30 | S:'$D(^LRO(69.2,LRAA,8,66,1,A,1,0)) ^(0)="^69.321DA^^" S X(1)=^(0),X=$P(X(1),"^",4)
|
|---|
| 31 | A S X=X+1 G:$D(^LRO(69.2,LRAA,8,66,1,A,1,X,0)) A
|
|---|
| 32 | S ^LRO(69.2,LRAA,8,66,1,A,1,0)=$P(X(1),"^",1,2)_"^"_X_"^"_($P(X(1),"^",4)+1),^(X,0)=A(3)_"^"_PNM_"^"_SSN,^(1,0)="^69.3211A^^"
|
|---|
| 33 | S ^LRO(69.2,LRAA,8,66,1,A,1,X,1,1,0)="Pre-op:"_$S($P(X(2),"^",2):"Yes",1:"No"),^LRO(69.2,LRAA,8,66,1,A,1,X,1,2,0)="Date wanted: "_Y_" #Units:"_$P(X(2),"^",4)_" Requestor:"_$P(X(2),"^",9)
|
|---|
| 34 | S ^LRO(69.2,LRAA,8,66,1,A,1,X,1,3,0)="Request entered by: "_$P(^VA(200,DUZ,0),"^")
|
|---|
| 35 | S X(3)=0,X(4)=3
|
|---|
| 36 | I $D(^LR(LRDFN,1.8,A,2)) S X(3)=^(2) S:$P(X(3),"^")]"" X(4)=X(4)+1,^LRO(69.2,LRAA,8,66,1,A,1,X,1,X(4),0)=$P(X(3),"^") S:$P(X(3),"^",2)]"" X(4)=X(4)+1,^LRO(69.2,LRAA,8,66,1,A,1,X,1,X(4),0)="Approved by: "_$P(X(3),"^",2)
|
|---|
| 37 | S Y=$P(X(3),"^",3) I Y,$D(^DIC(45.7,Y,0)) S Y=$P(^(0),"^"),Y(1)=^LRO(69.2,LRAA,8,66,1,A,1,X,1,1,0),^(0)=Y(1)_" Treating Specialty: "_Y
|
|---|
| 38 | F B=0:0 S B=$O(C(A,B)) Q:'B F E=0:0 S E=$O(C(A,B,E)) Q:'E D C
|
|---|
| 39 | I $D(LRK(A,1)) S X(4)=X(4)+1,^LRO(69.2,LRAA,8,66,1,A,1,X,1,X(4),0)=LRK(A,1)
|
|---|
| 40 | S Y=^LRO(69.2,LRAA,8,66,1,A,1,X,1,0),^(0)=$P(Y,"^",1,2)_"^"_X(4)_"^"_X(4) Q
|
|---|
| 41 | C Q:'$D(S(B,E)) S Y=S(B,E),X(4)=X(4)+1,^LRO(69.2,LRAA,8,66,1,A,1,X,1,X(4),0)=$P(Y,"^",3)_" "_$P(Y,"^",2)_":"_$P(Y,"^")_" "_$P(Y,"^",4)_" "_$P(Y,"^",5) Q
|
|---|
