| [613] | 1 | LRBLPCSS ;AVAMC/REG - PRE-OP COMPONENT SELECTION ;11/7/94 13:50 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**1,247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | I '$D(^SRF) W " *** No operation schedule file ***" G A
|
|---|
| 5 | I '$D(^SRF("ADT",DFN)) W !!,LRP," not in operation schedule file." G A
|
|---|
| 6 | S X="T",%DT="" D ^%DT S X1=Y,X2=-1 D C^%DTC S X=X+.99 K A
|
|---|
| 7 | 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:"")
|
|---|
| 8 | I 'C W !!,"No operations pending." G A
|
|---|
| 9 | I C=1 W !!,"Operation scheduled: " S X=1 D B Q
|
|---|
| 10 | 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)
|
|---|
| 11 | 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
|
|---|
| 12 | D B Q
|
|---|
| 13 | 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)
|
|---|
| 14 | S X=$O(^LAB(66.5,LRCPT,1,0)) I 'X S LRCPT=0 D W Q
|
|---|
| 15 | 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)
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | 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
|
|---|
| 19 | D:'$D(^LAB(66.5,X,0)) SET S Y=$O(^LAB(66.5,X,1,0)) I 'Y D W Q
|
|---|
| 20 | W !,"CPT file number: ",X F Z=0:0 S Z=$O(^ICPT(X,"D",Z)) Q:'Z W !,^(Z,0)
|
|---|
| 21 | S LRCPT=X D C Q
|
|---|
| 22 | ;
|
|---|
| 23 | SET ; also from MSB^LRBLS
|
|---|
| 24 | 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
|
|---|
| 25 | EN ;
|
|---|
| 26 | 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
|
|---|
| 27 | S A=$P(^LAB(66.5,LRCPT,1,C,0),"^",2)
|
|---|
| 28 | 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
|
|---|
| 29 | S:$D(LRR) LRK(C)="",LRK(C,1)="MSBOS:"_A_" operation: "_$P(^ICPT(LRCPT,0),"^",2) Q
|
|---|
| 30 | ;
|
|---|
| 31 | W W !!,"No maximum surgical blood orders for this operation.",!,"No maximum surgical blood order criteria checking can be done.",! Q
|
|---|
| 32 | ;
|
|---|
| 33 | ;called from LRBLPCS
|
|---|
| 34 | ;LRR set =1 if max surg blood criteria not met
|
|---|
