| 1 | LRBLJI ;AVAMC/REG - CHECK FILE ENTRIES ;2/18/93 09:14 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D END W !!?17,"Check inventory file entries for missing data.",!!
|
|---|
| 5 | S ZTRTN="QUE^LRBLJI" D BEG^LRUTL G:POP!($D(ZTSK)) END D QUE W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
|
|---|
| 6 | QUE U IO S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 7 | D L^LRU,S^LRU,H S LR("F")=1 F LRI=0:0 S LRI=$O(^LRD(65,LRI)) Q:'LRI!(LR("Q")) K LRB S W=$S($D(^(LRI,0)):^(0),1:"?"),W(4)=$S($D(^(4)):^(4),1:"") D C
|
|---|
| 8 | D K W !!,"Done." W !! W:$E(IOST,1,2)="P-" @IOF D END^LRUTL,END Q
|
|---|
| 9 | C S LR=$P(W,"^") I LR="?" W !,"IFN: ",LRI," 0th subscript missing- Database degradation!" Q
|
|---|
| 10 | I $L(LR)>4 F X(1)=2:1:4 I $A($E(LR,X(1)))>64 S ^LRD(65,"C",$E(LR,X(1),$L(LR)),LRI)="" Q
|
|---|
| 11 | I '$D(^LRD(65,"B",LR,LRI)) S ^LRD(65,"B",LR,LRI)="" D W Q:LR("Q") W !,"""B"" Cross reference required re-setting"
|
|---|
| 12 | I $P(W,"^",2)="" D W Q:LR("Q") W !,"SOURCE missing"
|
|---|
| 13 | I '$P(W,"^",5) D W Q:LR("Q") W !,"DATE/TIME RECEIVED missing"
|
|---|
| 14 | I $P(W,"^",3)="" D W Q:LR("Q") W !,"INVOICE# missing"
|
|---|
| 15 | I '$P(W,"^",6) D W Q:LR("Q") W !,"EXPIRATION DATE/TIME missing"
|
|---|
| 16 | I $P(W(4),"^",2),$P(W(4),"^")="" D W Q:LR("Q") W !,"DISPOSITION DATE present but DISPOSITION missing" Q
|
|---|
| 17 | Q:$P(W(4),"^")="" I '$P(W(4),"^",2) D W Q:LR("Q") W !,"DISPOSITION DATE missing"
|
|---|
| 18 | I $P(W(4),"^",3)="" D W Q:LR("Q") W !,"DISPOSITION ENTERING PERSON missing"
|
|---|
| 19 | I $P(W(4),"^")="MO",$O(^LRD(65,LRI,9,0))="" D W Q:LR("Q") W !,"MODIFIED TO/FROM missing" Q
|
|---|
| 20 | S X=+$P(W,"^",4),X=$S($D(^LAB(66,X,0)):$P(^(0),"^",27),1:"") I X,$P(W,"^",2)="SELF",$O(^LRD(65,LRI,9,0))="" D W Q:LR("Q") W !,"MODIFIED TO/FROM missing"
|
|---|
| 21 | Q
|
|---|
| 22 | W D:$Y>(IOSL-6) H Q:LR("Q") Q:$D(LRB) W !,LR("%"),!,"(IFN:",LRI,") Unit ID: ",LR,?39 S LRB=1,X=$P(W,"^",4),X=$S('X:"",$D(^LAB(66,X,0)):$P(^(0),"^"),1:"") W:X]"" X I X="" W "Component missing"
|
|---|
| 23 | Q
|
|---|
| 24 | K S X=0 F LRA=0:0 S X=$O(^LRD(65,"B",X)) Q:X="" F DA=0:0 S DA=$O(^LRD(65,"B",X,DA)) Q:'DA K:'$D(^LRD(65,DA,0)) ^LRD(65,"B",X,DA) I $D(^LRD(65,DA,0)) D:X'=$P(^(0),"^") D
|
|---|
| 25 | S X=0 F LRA=0:0 S X=$O(^LRD(65,"C",X)) Q:X="" F DA=0:0 S DA=$O(^LRD(65,"C",X,DA)) Q:'DA K:'$D(^LRD(65,DA,0)) ^LRD(65,"C",X,DA)
|
|---|
| 26 | Q
|
|---|
| 27 | D F LRF=1,2,3 X:$D(^DD(65,.01,1,LRF,2)) ^(2)
|
|---|
| 28 | S Y=^LRD(65,DA,0),S=$P(Y,"^",2),C=$P(Y,"^",4) I C,S]"" S Y=$O(^LAB(66,C,"SU","B",S,0)) S:Y Y=$L($P(^LAB(66,C,"SU",Y,0),"^",10)) K:Y ^LRD(65,"C",$E(X,Y+1,$L(X)),DA)
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 32 | D F^LRU W !?20,"Missing data from Blood Bank Inventory File",!,LR("%") Q
|
|---|
| 33 | ;
|
|---|
| 34 | END D V^LRU Q
|
|---|
| 35 | LRCKF ; Entry point for check all laboratory files option Routine LRCKF
|
|---|
| 36 | D END G QUE
|
|---|
