source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRGV1.m@ 1432

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1LRGV1 ;DALOI/RWF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;2/8/91 09:29
2 ;;5.2;LAB SERVICE;**112,153,269**;Sep 27, 1994
3 ;
4STUFF ;from LRGV
5 ;
6 ; Check if task has been asked to stop.
7 I $D(ZTQUEUED),$$S^%ZTLOAD D Q
8 . S ZTSTOP=1
9 . W !!,"*** Report requested to stop by TaskMan ***"
10 . W !,"*** Task #",$G(ZTQUEUED,"UNKNOWN")," stopped at ",$$HTE^XLFDT($H)," ***"
11 ;
12 N LRQUIT
13 ;
14 S LRQUIT=0
15 ;
16 L +^LAH(LRLL,1,LRSQ):1
17 I '$T W !,"Unable to obtain lock on sequence #",LRSQ Q
18 ;
19 ; Skip this sequence number if accession number is for a different area/date
20 S LRSQ(0)=^LAH(LRLL,1,LRSQ,0)
21 I $P(LRSQ(0),U,3)=LRAA,$P(LRSQ(0),U,4)=LRAD,$P(LRSQ(0),U,5)=LRAN
22 I '$T L -^LAH(LRLL,1,LRSQ) Q
23 ;
24 I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),U,2) D
25 . W !?5,"Corrupt Accession ",!
26 . D NOP
27 ;
28 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
29 S LRDFN=+X,LRODT=+$P(X,U,4),LRSN=+$P(X,U,5),LRLLOC=$P(X,U,7)
30 S:'$L(LRLLOC) LRLLOC=0
31 S LRORD=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
32 S X(3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
33 S LRIDT=$P(X(3),U,5)
34 S:'LRIDT LRIDT=9999999-X(3)
35 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
36 ;
37 K LRSA,LRSB,X
38 W " Auto Sequence #",LRSQ
39 I '$D(^LRO(68,+LRAA,1,+LRAD,1,+LRAN,0))!'$D(^(3)) D Q
40 . W ?40,"Accession NOT found."
41 . L -^LAH(LRLL,1,LRSQ)
42 ;
43 K ^TMP("LR",$J,"TMP")
44 D TEST^LRVR1
45 ;
46 ; Check for more than one sequence relating to this accession
47 S LRI=0
48 F S LRI=$O(^LAH(LRLL,1,"C",LRAN,LRI)) Q:'LRI D Q:LRQUIT
49 . I LRI=LRSQ Q
50 . S LRI(0)=$G(^LAH(LRLL,1,LRI,0))
51 . I $P(LRI(0),"^",3,5)'=LRAA_"^"_LRAD_"^"_LRAN Q
52 . S LRQUIT=1
53 . D INFO,NOP
54 I LRQUIT Q
55 ;
56 S LRMETH=$P(^LAH(LRLL,1,LRSQ,0),U,7)
57 I $O(^LAH(LRLL,1,LRSQ,1))<1 D Q
58 . W ?45,"There's NO Instrument Data "
59 . D NOP
60 ;
61 ; Get patient demographics
62 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
63 S:'$L($G(SEX)) SEX="M"
64 S:'$L($G(AGE)) AGE=99
65 W ! D DISPLAY^LRGP
66 ;
67 L +^LR(LRDFN,"CH",LRIDT):1
68 I '$T W !,"Unable to obtain lock on LAB DATA file" Q
69 ;
70 S LR0=$G(^LR(LRDFN,"CH",LRIDT,0))
71 I LR0="" W !,"DATA HEADER MISSING " D NOP Q
72 ;
73 S X=+$P(LR0,U,5),LRSPEC=-1,LRSPNAM="??"
74 I X S LRSPNAM=$P(^LAB(61,+X,0),U,1),LRSPEC=X
75 W !," Specimen: ",LRSPNAM
76 W ?26," Collection date/time: ",$$FMTE^XLFDT($P(LR0,"^"),"1M"),!
77 ;
78 I LRDPF'=62.3,LRSPEC'=$P(LR0,U,5) D Q
79 . W !," << SPECIMEN IS NOT ",LRSPNAM," >> "
80 . D NOP
81 ;
82 S LRVF=+$P(LR0,U,3)
83 I LRVF W !,"Some Data Already Verified ",!
84 ;
85 I '$T,$O(^LR(LRDFN,"CH",LRIDT,1))>1 D Q
86 . W !,"Some Unverified Data Already Entered. "
87 . D NOP
88 ;
89 D ^LRGV2
90 ;
91 L -^LR(LRDFN,"CH",LRIDT)
92 L -^LAH(LRLL,1,LRSQ)
93 ;
94 Q
95 ;
96NOP ; unlock from above
97 L -^LR(LRDFN,"CH",LRIDT)
98 L -^LAH(LRLL,1,LRSQ)
99 W !,">> Accession: ",LRAN," NOT VERIFIED <<"
100 I $E(IOST,1,2)="C-" W $C(7)
101 Q
102 ;
103 ;
104INFO ;
105 N X
106 W !,"Sequence #: ",LRSQ
107 S X=^LAH(LRLL,1,LRSQ,0)
108 ;
109 I LRWT="T" D
110 . I $P(X,"^") W ?20,"TRAY: ",$P(X,"^")
111 . I $P(X,"^",2) W ?33,"CUP: ",$P(X,"^",2)
112 ;
113 W ?45,"DUPLICATE "
114 Q
Note: See TracBrowser for help on using the repository browser.