- LROR9 ; IHS/DIR/FJE - ADD TESTS TO AN EXISTING ORDER THRU OE/RR 9/23/88 15:15 2/8/91 07:29 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN 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
- I '$D(^LRO(69,LRODT,1,LRSN,0)) W !,"Cannot add to this order." Q
- 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
- S LRADDTST="",LRORD=$P(^LRO(69,LRODT,1,LRSN,.1),"^") D:'$D(LRPARAM) EN^LRPARAM D PT,A
- END 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
- ;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
- 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,HRCN,J,K,S,X,Y,LRSN1,LRSAME ;IHS/ANMC/CLS 08/18/96
- 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
- K LROT,LRROD,LRSAV,LRSORD,LRSS,LRTSTS,LRZ
- Q
- A 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
- 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
- D ADD^LROW
- Q
- B S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S X3(+^(I,0),LRSAMP,LRSPEC)=""
- Q
- PT S LROR=$S($D(^LRO(69,LRODT,1,LRSN,0)):^(0),1:-1),LRDFN=+LROR I LRDFN<1 W " NO PATIENT" Q
- S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3) D PT^LRX
- ;H 1 W !!,"ORDER #: ",LRORD,?30,"PATIENT: ",PNM,?60,"SSN: ",SSN
- H 1 W !!,"ORDER #: ",LRORD,?30,"PATIENT: ",PNM,?60,"HRCN: ",HRCN ;IHS/ANMC/CLS 08/18/96
- S Y=$S($D(^LRO(69,LRODT,1,LRSN,1)):+^(1),1:"") I Y D DD^LRX W !," DRAW TIME: ",Y
- W ! S Y=$S($D(^LRO(69,LRODT,1,LRSN,3)):+^(3),1:"") I Y D DD^LRX W " LAB ARRIVAL: ",Y
- W:$D(^DPT(DFN,.1)) ?40,"WARD: ",^(.1)
- W:$P(LROR,"^",3) !," SPECIMEN: ",$S($D(^LAB(62,$P(LROR,"^",3),0)):$P(^(0),"^"),1:"??")
- 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
- TST S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 D TEST
- I $D(^LRO(69,LRODT,1,LRSN,1)),$L($P(^(1),"^",6)) W !,"COMMENT: ",$P(^(1),"^",6)
- S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !,?3,^(I,0)
- 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)
- Q
- TEST 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")
- W ?38," ",$S($D(^LRO(68,+$P(X,"^",4),0)):$P(^(0),"^"),1:""),?50," ",$P(X,"^",5)
- Q
- LROR9 ; IHS/DIR/FJE - ADD TESTS TO AN EXISTING ORDER THRU OE/RR 9/23/88 15:15 2/8/91 07:29 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- EN IF '$DATA(ORPK)
- QUIT
- SET LRODT=$PIECE(ORPK,"^")
- SET LRSN=$PIECE(ORPK,"^",2)
- SET LRTN=$PIECE(ORPK,"^",3)
- IF 'LRODT!('LRSN)!('LRTN)
- WRITE !,"Cannot add to this order."
- QUIT
- +1 IF '$DATA(^LRO(69,LRODT,1,LRSN,0))
- WRITE !,"Cannot add to this order."
- QUIT
- +2 SET LR2ORD=1
- IF $DATA(^LRO(69,LRODT,1,LRSN,2,LRTN,0))
- IF $PIECE(^(0),"^",3)
- WRITE !,"Tests have been accessioned, call the lab to add tests to the same order."
- GOTO END
- +3 SET LRADDTST=""
- SET LRORD=$PIECE(^LRO(69,LRODT,1,LRSN,.1),"^")
- IF '$DATA(LRPARAM)
- DO EN^LRPARAM
- DO PT
- DO A
- END KILL 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
- +1 ;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
- +2 ;IHS/ANMC/CLS 08/18/96
- KILL 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,HRCN,J,K,S,X,Y,LRSN1,LRSAME
- +3 KILL 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
- +4 KILL LROT,LRROD,LRSAV,LRSORD,LRSS,LRTSTS,LRZ
- +5 QUIT
- A SET X=^LRO(69,LRODT,1,LRSN,0)
- SET LRSAMP=$PIECE(X,"^",3)
- SET LRSPEC=$SELECT($DATA(^(4,1,0)):+^(0),1:0)
- IF LRSPEC
- IF LRSAMP
- DO B
- +1 KILL T
- SET DA=0
- FOR
- SET DA=$ORDER(^LRO(69,LRODT,1,"AA",LRDFN,DA))
- IF DA<1
- QUIT
- IF $SELECT($DATA(^LRO(69,LRODT,1,DA,1)):$PIECE(^(1),"^",4)'="U",1:1)
- SET S=$SELECT($DATA(^LRO(69,LRODT,1,DA,4,1,0)):+^(0),1:0)
- SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,DA,2,I))
- IF I<1
- QUIT
- SET T(+^(I,0),DA)=S
- +2 DO ADD^LROW
- +3 QUIT
- B SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
- IF I<1
- QUIT
- SET X3(+^(I,0),LRSAMP,LRSPEC)=""
- +1 QUIT
- PT SET LROR=$SELECT($DATA(^LRO(69,LRODT,1,LRSN,0)):^(0),1:-1)
- SET LRDFN=+LROR
- IF LRDFN<1
- WRITE " NO PATIENT"
- QUIT
- +1 SET LRDPF=$PIECE(^LR(LRDFN,0),"^",2)
- SET DFN=$PIECE(^(0),"^",3)
- DO PT^LRX
- +2 ;H 1 W !!,"ORDER #: ",LRORD,?30,"PATIENT: ",PNM,?60,"SSN: ",SSN
- +3 ;IHS/ANMC/CLS 08/18/96
- HANG 1
- WRITE !!,"ORDER #: ",LRORD,?30,"PATIENT: ",PNM,?60,"HRCN: ",HRCN
- +4 SET Y=$SELECT($DATA(^LRO(69,LRODT,1,LRSN,1)):+^(1),1:"")
- IF Y
- DO DD^LRX
- WRITE !," DRAW TIME: ",Y
- +5 WRITE !
- SET Y=$SELECT($DATA(^LRO(69,LRODT,1,LRSN,3)):+^(3),1:"")
- IF Y
- DO DD^LRX
- WRITE " LAB ARRIVAL: ",Y
- +6 IF $DATA(^DPT(DFN,.1))
- WRITE ?40,"WARD: ",^(.1)
- +7 IF $PIECE(LROR,"^",3)
- WRITE !," SPECIMEN: ",$SELECT($DATA(^LAB(62,$PIECE(LROR,"^",3),0)):$PIECE(^(0),"^"),1:"??")
- +8 SET L=+$PIECE(^LRO(69,LRODT,1,LRSN,0),"^",6)
- IF L
- SET LRMD=$SELECT($DATA(^VA(200,L,0)):$PIECE(^(0),"^"),1:L)
- WRITE ?30,"PHYSICIAN: ",LRMD
- TST SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,I))
- IF I<1
- QUIT
- DO TEST
- +1 IF $DATA(^LRO(69,LRODT,1,LRSN,1))
- IF $LENGTH($PIECE(^(1),"^",6))
- WRITE !,"COMMENT: ",$PIECE(^(1),"^",6)
- +2 SET I=0
- FOR
- SET I=$ORDER(^LRO(69,LRODT,1,LRSN,6,I))
- IF I<1
- QUIT
- WRITE !,?3,^(I,0)
- +3 IF '$DATA(LRADDTST)
- QUIT
- WRITE !,"Is this the one"
- SET %=1
- DO YN^DICN
- SET LRADDTST=$SELECT(%=1:LRORD,1:"")
- IF %=1
- SET X=^LRO(69,LRODT,1,LRSN,0)
- SET LRLLOC=$PIECE(X,"^",7)
- SET LROLLOC=$PIECE(X,"^",9)
- SET LRORDTIM=$PIECE($PIECE(X,"^",8),".",2)
- SET LRPRAC=$PIECE(X,"^",6)
- SET LRLWC=$PIECE(X,"^",4)
- +4 QUIT
- TEST SET X=^LRO(69,LRODT,1,LRSN,2,I,0)
- IF $PIECE(^(0),"^",3)
- SET LRNOP=1
- WRITE !," TEST: ",$SELECT($DATA(^LAB(60,+X,0)):$PIECE(^(0),"^"),1:"UNKNOWN"),?28," "
- SET LRURG=+$PIECE(X,"^",2)
- WRITE $SELECT($DATA(^LAB(62.05,LRURG,0)):$PIECE(^(0),"^"),1:"ROUTINE")
- +1 WRITE ?38," ",$SELECT($DATA(^LRO(68,+$PIECE(X,"^",4),0)):$PIECE(^(0),"^"),1:""),?50," ",$PIECE(X,"^",5)
- +2 QUIT
