source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROE.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1LROE ;DALOI/CJS/FHS-LAB ORDER ENTRY AND ACCESSION ;8/11/97
2 ;;5.2;LAB SERVICE;**100,121,201,221,263,286,360**;Sep 27, 1994;Build 1
3 K LRORIFN,LRNATURE,LREND,LRORDRR
4 S LRLWC="WC"
5 D ^LRPARAM
6 I $G(LREND) S LREND=0 Q
7L5 ;
8NEXT ;from LROE1
9 K DIR
10 I $D(LROESTAT) D:$P(LRPARAM,U,14) ^LRCAPV I $G(LREND) K LRLONG,LRPANEL Q
11 S (LRODT,X,DT)=$$DT^XLFDT(),LRODT0=$$FMTE^XLFDT(DT,5)
12 I '$D(^LRO(69,DT,1,0)) S ^LRO(69,DT,0)=DT,^LRO(69,DT,1,0)="^69.01PA^^",^LRO(69,"B",DT,DT)=""
13 I $D(^LAB(69.9,1,"RO")),+$H'=+$P(^("RO"),U) D
14 . W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7),!
15 . S DIR("A")=" Are you sure you want to continue",DIR(0)="Y",DIR("B")="No"
16 I $T D ^DIR G END:$D(DIRUT) I Y'=1 W !,"OK, try later." Q
17 S X="T-7",%DT="" D ^%DT S LRTM7=+Y
18 ;W @IOF
19 K DIC,LRSND,LRSN
20 W !!,"Select Order number: " R LRORD:DTIME Q:LRORD["^"!(LRORD[".")!($D(LRLONG)&(LRORD=""))
21 W @IOF S M9=0 G QUICK^LROE1:LRORD=""
22 I $L(LRORD)>8 W !,"The order number entered is too long." H 1 G NEXT
23 S:LRORD?.N LRORD=+LRORD IF LRORD'?.N D QMSG G NEXT
24 I '$D(^LRO(69,"C",LRORD)) W !!?10,"No order exist with that number ",$C(7),! G NEXT
25 S (LRCHK,LRNONE)=1,(M9,LRODT)=0
26 F S LRODT=+$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D
27 . S DA=0 F S DA=$O(^LRO(69,"C",LRORD,LRODT,DA)) Q:DA<1 S LRCHK=LRCHK-1 S:LRNONE'=2 LRNONE=0 D LROE2
28 I DOD'="" S Y=DOD D DD^LRX W !,!,?5,@LRVIDO,"Patient ",PNM," died on: ",Y,@LRVIDOF W !
29 I DOD'="" D I Y=0!($D(DIRUT)) K DIRUT,DTOUT,DUOUT,Y D KVAR^LRX G NEXT
30 . K Y
31 . S DIR(0)="Y"
32 . S DIR("A")="Do you wish to continue with this accession [Yes/No]"
33 . S DIR("T")=120
34 . D ^DIR K DIR
35 I LRNONE=2,LRCHK<1 W !,"The order has already been partially accessioned." H 1
36 I LRNONE=2,LRCHK>0 W !,"The order has already been accessioned." H 1 G NEXT
37 I LRNONE=1 W !,"No order exists with that number." H 1 G NEXT
38 I '$$GOT(LRORD,LRODT) G NEXT ;W !!,"All tests for this order have been canceled.",!,"Are you sure you want to accession it" S %=1 D YN^DICN I %'=1 G NEXT
39 K DIR S DIR("A")="Is this the correct order",DIR(0)="Y"
40 S DIR("B")="Yes"
41 D ^DIR K DIR
42 I $D(DIRUT)!(Y'=1) K LRSN G NEXT
43 L +^LRO(69,"C",LRORD):1
44 I '$T W !?5,"Someone else is editing this Order",!!,$C(7) G NEXT
45 K %DT
46 S LRSTATUS="C",%DT("B")=""
47 D TIME K %DT
48 D:$G(LRCDT)<1 UNL69 G NEXT:LRCDT<1
49 S LRTIM=+LRCDT
50 ;S:'$P(^LRO(69,LRODT,1,LRSN,0),U,8) $P(^(0),U,8)=LRTIM
51 S LRUN=$P(LRCDT,U,2) K LRCDT,LRSN
52MORE I M9>1 K DIR S DIR("A")="Do you have the entire order",DIR(0)="Y" D ^DIR K DIR S:Y=1 M9=0
53 I $D(DIRUT) D UNL69 G NEXT
54 S (LRODT,LRSND)=0
55 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 D
56 . S LRSND=0
57 . F S LRSND=$O(^LRO(69,"C",LRORD,LRODT,LRSND)) Q:LRSND<1 D
58 . . I $D(^LRO(69,LRODT,1,LRSND,1)),$P(^(1),U,4)="C" Q
59 . . S LRSN(LRSND)=LRSND,LRSN=LRSND
60 . . K LRAA D Q15^LROE2 K LRSN
61 D TASK,UNL69
62 G NEXT
63 ;
64 ;
65LROE2 ;
66 I $D(^LRO(69,LRODT,1,DA,1)),$P(^(1),U,4)="C" S LRNONE=2,LRCHK=LRCHK+1
67 K LRSN
68 S (LRSN,LRSN(DA))=+DA
69 I '$D(^LRO(69,LRODT,1,LRSN,0)) Q
70 S M9=$G(M9)+1,LRZX=^LRO(69,LRODT,1,LRSN,0),LRDFN=+LRZX,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM,?30,SSN S LRWRDS=LRWRD
71 W ?45,"Requesting location: ",$P(LRZX,U,7) S Y=$P(LRZX,U,5) D DD^LRX W !,"Date/Time Ordered: ",Y,?45,"By: ",$S($D(^VA(200,+$P(LRZX,U,2),0)):$P(^(0),U),1:"")
72 S LRSVSN=LRSN D ORDER^LROS S LRSN=LRSVSN
73 Q
74 ;
75 ;
76QMSG W !,"Enter the order entry number assigned when the test was ordered."
77 W:'$D(LRLONG) !,"If the test has not been ordered, type the RETURN key to order the test."
78 W !,"To exit, type the ""^"" key and RETURN key."
79 Q
80 ;
81 ;
82YN R X:DTIME S:'$T DTOUT=1 Q:X=""!(X["N")!(X["Y")
83 W !,"Answer 'Y' or 'N': " G YN
84 ;
85 ;
86EN ;
87LROEN S LRNCWL=1
88 D LROE,END K LRNCWL
89 Q
90 ;
91 ;
92EN01 ; ENTER ORDER # THEN ENTER DATA
93STAT ;
94 D ^LRPARAM
95 I '$D(LRLABKY) W !!?10,"You do not have the proper security Keys",! Q
96 ;
97 ; Select peforming laboratory
98 S X=$$SELPL^LRVERA(DUZ(2))
99 I X<1 D END Q
100 I X'=DUZ(2) N LRPL S LRPL=X
101 ;
102 S LRLONG="",LRPANEL=0,LROESTAT=""
103 S %H=$H-60 D YMD^LRX S LRTM60=9999999-X
104 D LROE K LRTM60,LRLONG,LREND,LROESTAT
105 D END
106 Q
107 ;
108 ;
109TIME ;from LROE1, LRORD1
110 S %DT="SET" W !,"Collection Date@Time: ",$S($D(%DT("B")):%DT("B"),1:"NOW"),"//" R X:DTIME I '$T!(X="^") S LRCDT=-1 Q
111 S:X="" X=$S($D(%DT("B")):%DT("B"),1:"N")
112 W:X["?" !!,"You may enter ""T@U"" or just ""U"", for Today at Unknown time",!!
113 I X["@U",$P(X,"@U",2)="" S X=$P(X,"@U",1) D ^%DT G TIME:Y<1 S LRCDT=+Y_"^1" Q
114 S:X="U" LRCDT=DT_"^1"
115 I X'="U" D ^%DT D:X'["?" TIME1 G TIME:X["?" S LRCDT=+Y_"^" G TIME:Y'["."
116 Q
117 ;
118TIME1 S X1=X,Y1=Y D TIME2 S X=X1,Y=Y1 K X1,Y1
119 Q
120 ;
121TIME2 S X="N",%DT="ST" D ^%DT Q:Y1'>Y F W !,"You have specified a collection time in the future. Are you sure" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o."
122 S:%'=1 X="?" S X1=X
123 Q
124 ;
125 ;
126TASK ;
127 I $D(LRLABLIO),$D(LRLBL) S ZTRTN="ENT^LRLABLD",ZTDTH=$H,ZTDESC="LAB LABELS",ZTIO=LRLABLIO,ZTSAVE("LRLBL(")="" D ^%ZTLOAD
128 K LRLBL
129 I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
130 I $D(LRCSQ),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
131 D STOP^LRCAPV K LRCOM,LRSPCDSC,LRCCOM,LRTCOM
132 Q
133 ;
134 ;
135END K DIR,DIRUT,GOT
136 D ^LRORDK,LROEND^LRORDK,STOP^LRCAPV
137 Q
138 ;
139 ;
140GOT(ORD,ODT) ;See if all tests have been canceled
141 N I,SN,ODT
142 S (GOT,ODT,SN)=0
143 F S ODT=$O(^LRO(69,"C",ORD,ODT)) Q:ODT<1 D
144 . S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1!(GOT) D
145 . . Q:'$D(^LRO(69,ODT,1,SN,0))
146 . . S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),"^",11) S GOT=1 Q
147 Q GOT
148 ;
149 ;
150UNL69 ;
151 L -^LRO(69,"C",+$G(LRORD))
152 Q
Note: See TracBrowser for help on using the repository browser.