source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LROR9.m@ 824

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1LROR9 ;SLC/DCM - ADD TESTS TO AN EXISTING ORDER THRU OE/RR; 9/23/88 15:15 ;2/8/91 07:29 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3EN Q:'$D(ORPK) S LRODT=$P(ORPK,"^"),LRSN=$P(ORPK,"^",2),LRTN=$P(ORPK,"^",3) I 'LRODT!('LRSN)!('LRTN) W !,"Cannot add to this order." Q
4 I '$D(^LRO(69,LRODT,1,LRSN,0)) W !,"Cannot add to this order." Q
5 S LR2ORD=1 I $D(^LRO(69,LRODT,1,LRSN,2,LRTN,0)),$P(^(0),"^",3) W !,"Tests have been accessioned, call the lab to add tests to the same order." G END
6 S LRADDTST="",LRORD=$P(^LRO(69,LRODT,1,LRSN,.1),"^") D:'$D(LRPARAM) EN^LRPARAM D PT,A
7END K X3,T,LRADDTST,LRFLOG,LRIOZERO,LRGCOM,LRM,LRNCWL,LRORDER,LRORDTIM,LRORIFN,LRSSX,LRSTIK,LRSVSN,LRTSTNM,LRTXD,LRTXP,LRWPC,LRBED,LRCCOM,LRCDT,LRCOM,LRCS,LRCSN,LRCSP,LRCSS,LRCSX,LRDFN,LRDPF,LRDTO,LREND,LREXP,LRI,LRIO,LRLLOC,LRLWC
8 K LR2ORD,LRMAX,LRMOR,LRNN,LRODT,LRORD,LRPR,LRPRAC,LRSAMP,LRTSTN,LRSN,LRSNO,LRSPEC,LRSSP,LRTEST,LRTIME,LRTN,LRTP,LRTSN,LRTY,LRUR,LRUSI,LRUSNM,LRXS,LRXST,LRY,PNM,SEX,SSN,J,K,S,X,Y,LRSN1,LRSAME
9 K DIC,L,LRAA,LRAAO,LRACN0,LRAD,LRAN,LRCW,LRFOOT,LRHF,LRLAB,LRLL,LROD0,LROD1,LROD3,LROOS,LROS,LROSD,LRBLOOD,LRC,LRDT0,LRJ,LRMD,LRODTSV,LROR,LRORN,LRPARAM,LRPLASMA,LRSERUM,LRSNSV,LRTNSV,LRUNKNOW,LRUNQ,LRURG,LRURINE,LRWRD,LRZX,NOW,X1,X5
10 K LROT,LRROD,LRSAV,LRSORD,LRSS,LRTSTS,LRZ
11 Q
12A S X=^LRO(69,LRODT,1,LRSN,0),LRSAMP=$P(X,"^",3),LRSPEC=$S($D(^(4,1,0)):+^(0),1:0) I LRSPEC,LRSAMP D B
13 K T S DA=0 F S DA=$O(^LRO(69,LRODT,1,"AA",LRDFN,DA)) Q:DA<1 I $S($D(^LRO(69,LRODT,1,DA,1)):$P(^(1),"^",4)'="U",1:1) S S=$S($D(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0) S I=0 F S I=$O(^LRO(69,LRODT,1,DA,2,I)) Q:I<1 S T(+^(I,0),DA)=S
14 D ADD^LROW
15 Q
16B S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S X3(+^(I,0),LRSAMP,LRSPEC)=""
17 Q
18PT S LROR=$S($D(^LRO(69,LRODT,1,LRSN,0)):^(0),1:-1),LRDFN=+LROR I LRDFN<1 W " NO PATIENT" Q
19 S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3) D PT^LRX
20 H 1 W !!,"ORDER #: ",LRORD,?30,"PATIENT: ",PNM,?60,"SSN: ",SSN
21 S Y=$S($D(^LRO(69,LRODT,1,LRSN,1)):+^(1),1:"") I Y D DD^LRX W !," DRAW TIME: ",Y
22 W ! S Y=$S($D(^LRO(69,LRODT,1,LRSN,3)):+^(3),1:"") I Y D DD^LRX W " LAB ARRIVAL: ",Y
23 W:$D(^DPT(DFN,.1)) ?40,"WARD: ",^(.1)
24 W:$P(LROR,"^",3) !," SPECIMEN: ",$S($D(^LAB(62,$P(LROR,"^",3),0)):$P(^(0),"^"),1:"??")
25 S L=+$P(^LRO(69,LRODT,1,LRSN,0),"^",6) I L S LRMD=$S($D(^VA(200,L,0)):$P(^(0),"^"),1:L) W ?30,"PHYSICIAN: ",LRMD
26TST S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 D TEST
27 I $D(^LRO(69,LRODT,1,LRSN,1)),$L($P(^(1),"^",6)) W !,"COMMENT: ",$P(^(1),"^",6)
28 S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !,?3,^(I,0)
29 Q:'$D(LRADDTST) W !,"Is this the one" S %=1 D YN^DICN S LRADDTST=$S(%=1:LRORD,1:"") I %=1 S X=^LRO(69,LRODT,1,LRSN,0),LRLLOC=$P(X,"^",7),LROLLOC=$P(X,"^",9),LRORDTIM=$P($P(X,"^",8),".",2),LRPRAC=$P(X,"^",6),LRLWC=$P(X,"^",4)
30 Q
31TEST S X=^LRO(69,LRODT,1,LRSN,2,I,0) S:$P(^(0),"^",3) LRNOP=1 W !," TEST: ",$S($D(^LAB(60,+X,0)):$P(^(0),"^"),1:"UNKNOWN"),?28," " S LRURG=+$P(X,"^",2) W $S($D(^LAB(62.05,LRURG,0)):$P(^(0),"^"),1:"ROUTINE")
32 W ?38," ",$S($D(^LRO(68,+$P(X,"^",4),0)):$P(^(0),"^"),1:""),?50," ",$P(X,"^",5)
33 Q
Note: See TracBrowser for help on using the repository browser.