source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCKF69.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LRCKF69 ;SLC/RWF - CHECK FILE 69 ; 2/22/87 1:47 PM ;
2 ;;5.2;LAB SERVICE;**272,293**;Sep 27, 1994
3 S ZTRTN="ENT^LRCKF69" D LOG^LRCKF Q:LREND D ENT W !! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
4ENT ;from LRCKF
5 U IO W !," CHECKING FILE 69",! S LRPSN=0,U="^" S:'$D(LRODT) LRODT=DT F I=1:1:10 S E(9,I)=0
6 F LRODT=0:0 S LRODT=$O(^LRO(69,LRODT)) Q:LRODT<1 D LRSN
7 W !! W:$E(IOST,1,2)="P-" @IOF Q
8 Q
9LRSN I '$O(^LRO(69,LRODT,1,0)) W "." Q
10 S Y=LRODT D DD^LRX W:$Y'<IOSL @IOF W !,"ORDER DATE: ",Y
11 I LRODT["." W !?10,"BAD ORDER DATE ",!
12 F LRSN=0:0 S LRSN=$O(^LRO(69,LRODT,1,LRSN)) Q:LRSN'>0 D CHK69
13 Q
14NAME S E(9,E)=1+E(9,E) I E(9,E)>20 S E=0 Q
15 I LRPSN'=LRSN W !!,"ORDER: ",LRORDER," LRSN: ",LRSN S LRPSN=LRSN
16 Q
17CHK69 I $D(^LRO(69,LRODT,1,LRSN,0))[0 Q ;MUST BE A PLACE HOLDER
18 S LA=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LA,LRORDER=$S($D(^(.1)):^(.1),1:""),LRCTRL=$S($D(^LR(LRDFN,0))#2:$P(^(0),U,2),1:0)=62.3
19 I $D(^LR(LRDFN,0))[0 S E=1 D NAME I E W !?5,"F- Entry ",LRDFN," in ^LR( is missing."
20 I 'LRCTRL,LRORDER="" S E=2 D NAME I E W !?5,"F- Does not have an ORDER number."
21 I 'LRCTRL,$D(^LAB(62,+$P(LA,U,3),0))[0 S E=3 D NAME I E W !?5,"F- BAD pointer (",$P(LA,U,3),") to collection file."
22 I 'LRCTRL,$D(^VA(200,+$P(LA,U,2),0))[0 S E=4 D NAME I E W !?5,"F- BAD pointer to user New Person file."
23 F T=0:0 S T=$O(^LRO(69,LRODT,1,LRSN,2,T)) Q:T'>0 I $D(^(T,0))#2 S X=^(0) D TEST
24 F T=0:0 S T=$O(^LRO(69,LRODT,1,LRSN,4,T)) Q:T'>0 I $D(^(T,0))#2 S X=^(0) D SPEC
25 Q
26TEST I $D(^LAB(60,+X,0))[0 S E=5 D NAME I E W !?5,"F- BAD pointer to test file (60)."
27 I $D(^LAB(62.05,+$P(X,U,2),0))[0 S E=6 D NAME I E W !?5,"F- BAD pointer to urgency file (62.05)."
28 S LRAD=$P(X,U,3),LRAA=$P(X,U,4),LRAN=$P(X,U,5)
29 I LRAA,LRAD,LRAN,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))[0 S E=7 D NAME I E W !?5,"F- BAD pointer to the accession file."
30 Q
31SPEC I $D(^LAB(61,+X,0))[0 S E=8 D NAME I E W !?5,"F- BAD pointer to the specimen file (61)."
32 Q
Note: See TracBrowser for help on using the repository browser.