LRBLPCSS ;AVAMC/REG - PRE-OP COMPONENT SELECTION ;11/7/94  13:50 ;
 ;;5.2;LAB SERVICE;**1,247**;Sep 27, 1994
 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021
 I '$D(^SRF) W "  *** No operation schedule file ***" G A
 I '$D(^SRF("ADT",DFN)) W !!,LRP," not in operation schedule file." G A
 S X="T",%DT="" D ^%DT S X1=Y,X2=-1 D C^%DTC S X=X+.99 K A
 S C=0 F B=0:0 S X=$O(^SRF("ADT",DFN,X)) Q:'X  S A=0 F B(1)=0:0 S A=$O(^SRF("ADT",DFN,X,A)) Q:'A  S C=C+1,Y=^SRF("ADT",DFN,X,A) D D^LRU S A(C)=Y_"^"_$S($D(^SRF(A,"OP")):^("OP"),1:"")
 I 'C W !!,"No operations pending." G A
 I C=1 W !!,"Operation scheduled: " S X=1 D B Q
 W !!?5,"Date:",?20,"Operation:" S A=0 F B=0:1 S A=$O(A(A)) Q:'A  W !,$J(A,2),") ",$P(A(A),"^")," ",$P(A(A),"^",2)
P W !!,"Select OPERATION (1-",B,"): " R X:DTIME Q:X["^"!(X="")  I X<1!(X>B)!(+X'=X) W $C(7),!,"Select a number from 1 to ",B G P
 D B Q
B W "  ",$P(A(X),"^"),!,$P(A(X),"^",2) S X=$P(A(X),"^",3) I X,$D(^ICPT(X,0)) S LRCPT=X W !,"CPT file number: ",LRCPT F Y=0:0 S Y=$O(^ICPT(X,"D",Y)) Q:'Y  W !,^(Y,0)
 S X=$O(^LAB(66.5,LRCPT,1,0)) I 'X S LRCPT=0 D W Q
C F X=0:0 S X=$O(^LAB(66,LRCPT,1,X)) Q:'X  S X(1)=^(X,0) W !,"Component: ",$S($D(^LAB(66,X,0)):$P(^(0),"^"),1:""),?52,"MSBOS:",$P(X(1),"^",2)
 Q
 ;
A Q:'$D(^ICPT(0))  W ! S DIC="^ICPT(",DIC(0)="AEQMZ",DIC("A")="Select OPERATION: ",DIC("S")="I $P(^(0),""^"",3),$P(^DIC(81.1,$P(^DIC(81.1,$P(^ICPT(Y,0),""^"",3),0),""^"",3),0),""^"")=""SURGERY""" D ^DIC K DIC Q:Y<1  S X=+Y
 D:'$D(^LAB(66.5,X,0)) SET S Y=$O(^LAB(66.5,X,1,0)) I 'Y D W Q
 W !,"CPT file number: ",X F Z=0:0 S Z=$O(^ICPT(X,"D",Z)) Q:'Z  W !,^(Z,0)
 S LRCPT=X D C Q
 ;
SET ; also from MSB^LRBLS
 L +^LAB(66.5) S DA=X,^LAB(66.5,X,0)=X,Z=^LAB(66.5,0),^(0)=$P(Z,"^",1,2)_"^"_X_"^"_($P(Z,"^",4)+1) L -^LAB(66.5) X:$D(^DD(66.5,.01,1,1,1)) ^(1) Q
EN ;
 I '$D(^LAB(66.5,LRCPT,1,C)) W !!,"No maximum surgical blood order entered in file 66.5 for this component.",!,"No maximum surgical blood order criteria checking can be done.",! Q
 S A=$P(^LAB(66.5,LRCPT,1,C,0),"^",2)
 Q:X'>A  W $C(7),!!,"Number exceeds maximum surgical blood order number (",A,") for this component",!,"for this procedure.  Request still OK " S %=2 D YN^LRU S:%=1 LRR=1 I %'=1 S Y=0 D DEL^LRBLPCS
 S:$D(LRR) LRK(C)="",LRK(C,1)="MSBOS:"_A_" operation: "_$P(^ICPT(LRCPT,0),"^",2) Q
 ;
W W !!,"No maximum surgical blood orders for this operation.",!,"No maximum surgical blood order criteria checking can be done.",! Q
 ;
 ;called from LRBLPCS
 ;LRR set =1 if max surg blood criteria not met