46 lines
3.2 KiB
Mathematica
46 lines
3.2 KiB
Mathematica
LRBLJW ;AVAMC/REG/CYM - INVENTORY ABO/RH WORKSHEET ;6/14/96 20:40 ;
|
|
;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
|
|
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|
D END S LR("M")=1,X="BLOOD BANK" D ^LRUTL G:Y=-1 END S:'$D(^LRO(69.2,LRAA,6,0)) ^(0)="^69.26A^^"
|
|
W !?24,"PRINT ABO/RH INVENTORY WORKSHEET",!!
|
|
I $O(^LRO(69.2,LRAA,6,0)) W !,"List ABO/Rh worksheet entries " S %=2 D YN^LRU Q:%<1 I %=1 S LR("Q")=0 D L K ^TMP($J)
|
|
W !,"Add/delete ABO/Rh worksheet entries " S %=2 D YN^LRU Q:%<1 D:%=1 C
|
|
I '$O(^LRO(69.2,LRAA,6,0)) W $C(7),!!,"THERE ARE NO ENTRIES TO PRINT !" Q
|
|
W !!,"Save list for repeat printing " S %=2 D YN^LRU Q:%<1 S:%=1 S=1
|
|
S ZTRTN="QUE^LRBLJW" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|
QUE U IO S C(3)=0 D L^LRU,S^LRU,H S LR("F")=1
|
|
S LRN=1 D L K:'$D(S) ^LRO(69.2,LRAA,6) D FT,END^LRUTL,END Q
|
|
WRK D:$Y>(IOSL-10) H1 Q:LR("Q") W !,$J(C,3),")",?5,$P(LRI,"^"),?19,$J($P(LRI,"^",7),2),?23,$P(LRI,"^",8),?27,"|",?38,"|",?43,"| | | | | | | |",!,LR("%") Q
|
|
;
|
|
S F LR=0:0 S LR=$O(^LRO(69.2,LRAA,6,LR)) Q:'LR I $D(^LRD(65,LR,0)) S X=^(0),^TMP($J,$P(X,"^",3),$P(X,"^"),LR)=X
|
|
Q
|
|
;
|
|
C W ! S DIC="^LRD(65,",DIC(0)="AEFQM",DIC("A")="Select Unit ID: ",DIC("S")="I $P(^(0),U,16)" D ^DIC K DIC Q:X=""!(X[U) S LR=+Y
|
|
I $D(^LRO(69.2,LRAA,6,LR)) W !?3,$P(Y,U,2)," is an entry for the ABO/RH INVENTORY WORKSHEET.",!?3,"Do you want to delete it " S %=2 D YN^LRU G:%'=1 C D D G C
|
|
W !?3,"Do you want to add ",$P(Y,U,2)," to the ABO/RH INVENTORY WORKSHEET " S %=2 D YN^LRU G:%'=1 C
|
|
S:'$D(^LRO(69.2,LRAA,6,0)) ^(0)="^69.26A^^"
|
|
L +^LRO(69.2,LRAA,6):5 I '$T W $C(7),!!,"I can't add this to the worksheet now ",!!,"Someone else is editing this record",!! G C
|
|
S X=^LRO(69.2,LRAA,6,0),^(0)=$P(X,U,1,2)_"^"_LR_"^"_($P(X,"^",4)+1),^LRO(69.2,LRAA,6,LR,0)=LR L -^LRO(69.2,LRAA,6)
|
|
G C
|
|
D L +^LRO(69.2,LRAA,6):5 I '$T W $C(7),!!,"I can't delete this from the worksheet now",!!,"Someone else is editing this record",!! Q
|
|
K ^LRO(69.2,LRAA,6,LR) S X=^LRO(69.2,LRAA,6,0),X(1)=$O(^(0)),^(0)=$P(X,U,1,2)_U_X(1)_U_$S(X(1)="":"",1:($P(X,U,4)-1)) L -^LRO(69.2,LRAA,6) Q
|
|
;
|
|
L D S S (A,C,E,F)=0
|
|
F G=0:0 S F=$O(^TMP($J,F)) Q:F=""!(LR("Q")) D:$D(LRN) INV S:$D(LRN) C=0 F B=0:0 S A=$O(^TMP($J,F,A)) Q:A=""!(LR("Q")) F I=0:0 S I=$O(^TMP($J,F,A,I)) Q:'I!(LR("Q")) S C=C+1,LRI=^(I) D @$S($D(LRN):"WRK",1:"W")
|
|
Q
|
|
W W:C#2=1 ! W:C#2=0 ?40 W $J(C,2),") ",$P(LRI,"^")," ",$J($P(LRI,"^",7),2)," ",$P(LRI,"^",8) D:C#40=0 M Q
|
|
INV Q:LR("Q") W !,"Invoice #: ",F Q
|
|
;
|
|
M W !,"'^' TO STOP: " R X:DTIME W $C(13),$J("",15),$C(13) S:'$T!(X[U) LR("Q")=1 Q
|
|
;
|
|
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|
D F^LRU W !,LRO(68)," INVENTORY ABO/Rh TESTING WORKSHEET"
|
|
W !,"Incubator temp:",?28,"Reagent rack:",!,"Num",?5,"Donor ID",?18,"|Supplier",?27,"|VA interp",?38,"| |---ANTI----|Rh| |Du|"
|
|
W !?18,"|ABO Rh",?27,"| ABO Rh",?38,"|tech",?42,"|A |B |AB| D|Ct|Du|Ct|",!,LR("%") Q
|
|
H1 D H,INV Q
|
|
FT S LRI=$O(^LAB(65.9,"B","INVENTORY WORKSHEET",0)) I 'LRI W !!,"INVENTORY WORKSHEET must be an entry in the LAB LETTER FILE (65.9)",!,"to print legend." Q
|
|
D:$Y>(IOSL-6) H Q:LR("Q") K ^TMP($J) S X=^LAB(65.9,LRI,0),DIWL=$P(X,U,5),DIWR=IOM-$P(X,U,6),DIWF="W"
|
|
S LRA=0 F LRZ=0:1 S LRA=$O(^LAB(65.9,LRI,2,LRA)) Q:'LRA!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S X=^LAB(65.9,LRI,2,LRA,0) D ^DIWP
|
|
Q:LR("Q") D:LRZ ^DIWW Q
|
|
END D V^LRU Q
|