198 lines
6.8 KiB
Mathematica
198 lines
6.8 KiB
Mathematica
|
LRCE ;SLC/RWF/DALOI/JMC - LOOK-UP ON CENTRAL ENTRY # ;8/11/97
|
||
|
|
;;5.2;LAB SERVICE;**28,76,103,121,153,210,202,263**;Sep 27, 1994
|
||
|
|
EN ;
|
||
|
|
S (LRSTOP,LRFLAG1,LRFLG,LRSN1,LRNOP)=0
|
||
|
|
K DIRUT,SSN,LRORD
|
||
|
|
W !!
|
||
|
|
S DIR("A")="Order Number or UID: ",DIR(0)="FOA"
|
||
|
|
S DIR("?",1)="Enter a whole number for the order number, enter the universal identifier"
|
||
|
|
S DIR("?",2)="(UID), or press Return to find the order number by Patient.",DIR("?")="Enter '^' to Exit."
|
||
|
|
D ^DIR
|
||
|
|
I $G(SSN)&(Y="") G END
|
||
|
|
I Y="" D ^LROS G:'$G(SSN) END G EN
|
||
|
|
NEXT I $D(DIRUT) G END
|
||
|
|
D UNIV
|
||
|
|
S LRORD=+Y I LRORD?.AP!(LRORD<1) D G EN
|
||
|
|
. W !,"Enter a whole number for the order number."
|
||
|
|
S LRORD=+LRORD
|
||
|
|
K DIR,X,Y,DIRUT
|
||
|
|
IF $O(^LRO(69,"C",LRORD,0))<1 W " NUMBER NOT FOUND" G LRCE
|
||
|
|
DIS ;
|
||
|
|
W @IOF
|
||
|
|
I $D(LRADDTST) D
|
||
|
|
. W !!?15,"LISTING OF DATES "
|
||
|
|
. S (CNT,LRODT)=0
|
||
|
|
. F A=0:0 S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT="" D
|
||
|
|
.. D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
.. S CNT=CNT+1
|
||
|
|
.. W !?5,CNT,?10,$$FMTE^XLFDT(LRODT,"5FM")
|
||
|
|
Q:$G(LRSTOP) K CNT,A
|
||
|
|
S LRODT=0
|
||
|
|
F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1!($G(LRSTOP)) D I $D(LRADDTST),+LRADDTST Q
|
||
|
|
. D LR2
|
||
|
|
I $D(LRADDTST) G LRCE:LRADDTST="" G END
|
||
|
|
I '$D(LRADDTST) G EN
|
||
|
|
Q
|
||
|
|
ADDTST ;
|
||
|
|
S LRADDTST="" D EN
|
||
|
|
S LRRSTAT=160
|
||
|
|
I LRADDTST D ^LRORD
|
||
|
|
D END,ADDEND
|
||
|
|
Q
|
||
|
|
ADDEND ;
|
||
|
|
K LRCLCTR,LRCLST,LRDFN,LRDPF,LRDRWTM,LRFLAG1,LRFLG
|
||
|
|
K LRLLOC,LRLOC,LRODT,LROLLOC,LRORDRR,LRPRAC,LRRB
|
||
|
|
K LRRSITE,LRSD,LRDN,LRSTOP,LRTREA,LRSN,LRTSN,LRTSP,PNM,SSN,DOB,SEX
|
||
|
|
K TYPE,LRRSTAT,LRNOP,LRSN1
|
||
|
|
K X,Y,I
|
||
|
|
Q
|
||
|
|
LR2 ;
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
S LRSN=0
|
||
|
|
F S LRSN=+$O(^LRO(69,"C",+$G(LRORD),+$G(LRODT),LRSN)) Q:LRSN<1!($G(LRSTOP)) D PT I $D(LRADDTST),+LRADDTST Q
|
||
|
|
Q
|
||
|
|
UNIV ; see if entry is UID
|
||
|
|
N LRAA,LRAD,LRAN I $D(^LRO(68,"C",X)) S LRAA=$O(^LRO(68,"C",X,0)) I LRAA S LRAD=$O(^LRO(68,"C",X,LRAA,0)) I LRAD S LRAN=$O(^LRO(68,"C",X,LRAA,LRAD,0)) I LRAN S Y=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)),"^")
|
||
|
|
Q
|
||
|
|
CHKPAGE ;
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
Q:$Y<(IOSL-2)
|
||
|
|
K DIR
|
||
|
|
S DIR(0)="E"
|
||
|
|
D ^DIR
|
||
|
|
I $D(DUOUT)!($D(DIRUT)) S LRSTOP=1 Q
|
||
|
|
W @IOF
|
||
|
|
W !
|
||
|
|
Q
|
||
|
|
PT ;
|
||
|
|
D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)!($G(LRFLG))
|
||
|
|
S LROR=$S($D(^LRO(69,LRODT,1,LRSN,0)):^(0),1:-1)
|
||
|
|
S LRDFN=+LROR
|
||
|
|
I LRDFN<1 W " NO PATIENT" Q
|
||
|
|
S LRWHOE=+$P(LROR,U,2)
|
||
|
|
S LRWHOE=$S($D(^VA(200,LRWHOE,0)):$P(^(0),U),1:"")
|
||
|
|
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
|
||
|
|
D PT^LRX
|
||
|
|
H 1
|
||
|
|
HEAD ;
|
||
|
|
D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
W !!,"ORDER #: ",LRORD,?20,"PAT: ",PNM," SSN: ",SSN,!
|
||
|
|
D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
D LRGLIN^LRX
|
||
|
|
W !
|
||
|
|
S LRCTYP=$P(LROR,U,4)
|
||
|
|
I ($L(LRWHOE))!($L(LRCTYP)) D
|
||
|
|
. I $L(LRWHOE) W "WHO ENTERED: ",$E(LRWHOE,1,25) K LRWHOE
|
||
|
|
. W:$L(LRCTYP) ?40,"TYPE OF COLLECTION: ",LRCTYP
|
||
|
|
I $D(^LRO(69,LRODT,1,LRSN,1)) D
|
||
|
|
. S LRCLCTR=$P(^LRO(69,LRODT,1,LRSN,1),U,3),LRCLST=$P(^(1),U,4)
|
||
|
|
. S:$L(LRCLCTR) LRCLCTR=$P($G(^VA(200,+LRCLCTR,0)),U)
|
||
|
|
. W ! D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
. W:$L(LRCLCTR) " COLLECTOR : ",$E(LRCLCTR,1,25)
|
||
|
|
. W:$L(LRCLST) ?40,"COLLECTION STATUS: ",LRCLST
|
||
|
|
Q:$G(LRSTOP) S LRDRWTM=$S($D(^LRO(69,LRODT,1,LRSN,1)):+^(1),1:"")
|
||
|
|
S:LRDRWTM LRDRWTM=$$FMTE^XLFDT(LRDRWTM,"5FM")
|
||
|
|
S LRLOC=+$P(LROR,U,9),LRLOC=$P($G(^SC(LRLOC,0)),U)
|
||
|
|
I ($L(LRDRWTM))!($L(LRLOC)) D
|
||
|
|
. W ! D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
. W:$L(LRDRWTM) " DRAW TIME: ",LRDRWTM
|
||
|
|
. I '$L(LRDRWTM),$P(LROR,"^",8) W "TO BE DRAWN: ",$$FMTE^XLFDT($P(LROR,U,8),"5FM")
|
||
|
|
. W:$L(LRLOC) ?40,"ORDERING LOCATION: ",$E(LRLOC,1,20)
|
||
|
|
Q:$G(LRSTOP) W ! D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
I $G(^LRO(69,LRODT,1,LRSN,3)) W " LAB ARRIVAL: ",$$FMTE^XLFDT(+$G(^(3)),"5FM")
|
||
|
|
I LRDPF=2 W:$L(LRWRD) ?40,"WARD: ",LRWRD
|
||
|
|
W:$P(LROR,U,3) !," SPECIMEN: " D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
W:$P(LROR,U,3) $S($D(^LAB(62,$P(LROR,U,3),0)):$P(^(0),U),1:"??")
|
||
|
|
S L=+$P(^LRO(69,LRODT,1,LRSN,0),U,6) I L D
|
||
|
|
. S LRMD=$S($D(^VA(200,L,0)):$P(^(0),U),1:L)
|
||
|
|
. W ?40,"PROVIDER: ",$E(LRMD,1,30)
|
||
|
|
W:$G(^LRO(69,LRODT,1,LRSN,"PCE")) !,?5,"Visit Number(s): ",$G(^("PCE"))
|
||
|
|
;
|
||
|
|
S I=0
|
||
|
|
TST D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 D
|
||
|
|
. D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
. D TEST D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
D CHKPAGE
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
I $D(^LRO(69,LRODT,1,LRSN,1)),$L($P(^(1),U,6)) D
|
||
|
|
. W !,"COMMENT: ",$P(^LRO(69,LRODT,1,LRSN,1),U,6) D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
S I=0
|
||
|
|
F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !,?3,^(I,0) D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
Q:$G(LRSTOP)
|
||
|
|
NXT S X=$P($G(^LRO(69,LRODT,1,LRSN,1)),U,4)
|
||
|
|
I X="C"!($G(LRNOP)) W !,"Order has already been accessioned."
|
||
|
|
I LRNOP,'$P($G(LRLABKY),U) W !,"Tests have been accessioned, call the lab to add tests to the same order." Q
|
||
|
|
I '$D(LRADDTST) Q
|
||
|
|
I X="M" W !?5,"This Order was Merged " Q
|
||
|
|
I '$G(LRRSTAT) S LRRSTAT=160
|
||
|
|
SEL W !,"Is this the one"
|
||
|
|
S %=1,LRNOP=0 K LRORDRR,LRRSITE,LRSD,LRTSP
|
||
|
|
D YN^DICN
|
||
|
|
I %'=1 S (LRFLG1,LRNOP)=0 Q
|
||
|
|
S LRADDTST=$S(%=1:LRORD,1:"")
|
||
|
|
Q:$G(LRSTOP)!('$G(LRADDTST))
|
||
|
|
I %=1 D
|
||
|
|
. N X,X0,I,DIC,DA
|
||
|
|
. S X0=^LRO(69,LRODT,1,LRSN,0),LRLWC=$P(X0,"^",4)
|
||
|
|
. S LRFLG=1
|
||
|
|
. S LRPRAC=$P(X0,"^",6),LRLLOC=$P(X0,"^",7),LROLLOC=$P(X0,U,9)
|
||
|
|
. Q:LRLWC'="R" S LRRSITE("SDT")=$P(X0,U,5)
|
||
|
|
. S DIC("A")="*Select Orginal Ordered Test "
|
||
|
|
. S DA=LRSN,DA(1)=LRODT,DIC("S")="I $G(^(.3))"
|
||
|
|
. S DIC="^LRO(69,"_LRODT_",1,"_LRSN_",2,",DIC(0)="AQEZNM"
|
||
|
|
. D ^DIC I Y<1 S LRADDTST="" Q
|
||
|
|
. S LRTSP=$P(Y,U,2),X=$G(^LRO(69,LRODT,1,LRSN,2,+Y,.3))
|
||
|
|
. Q:'$P(X,U,2) S (LRSD("RPSITE"),LRRSITE("RSITE"))=$P(X,U,2)_U_$P(^LRO(69,LRODT,1,LRSN,0),U,7)
|
||
|
|
. S LRRSITE("RPSITE")=$P(X,U,3)
|
||
|
|
. S LRSD("RUID")=$P(X,U,5)
|
||
|
|
. S LRORDRR="R"
|
||
|
|
Q
|
||
|
|
LUPT ;
|
||
|
|
K DFN,DIC S DIC(0)="EMQ"
|
||
|
|
D ^LRDPA
|
||
|
|
Q:DFN<1!$D(DUOUT)
|
||
|
|
LU1 ;
|
||
|
|
W !,"Order date to start from: T//" R X:DTIME
|
||
|
|
I '$T!(X["^") QUIT
|
||
|
|
S %DT="E",X=$S(X="":"T",1:X)
|
||
|
|
D ^%DT
|
||
|
|
G:Y<1 LU1 S Y=Y-1
|
||
|
|
S LRODT=Y F S LRODT=$O(^LRO(69,LRODT)) Q:LRODT<1 D FSN
|
||
|
|
Q
|
||
|
|
FSN ;
|
||
|
|
S LRSN=0
|
||
|
|
F S LRSN=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D
|
||
|
|
. Q:'$D(^LRO(69,LRODT,1,LRSN,.1)) S LRORD=+^(.1) D PT
|
||
|
|
Q
|
||
|
|
TEST ;
|
||
|
|
D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
S X=^LRO(69,LRODT,1,LRSN,2,I,0) S:$P(^(0),U,3) LRNOP=1 W !," TEST: ",$S($D(^LAB(60,+X,0)):$P(^(0),"^"),1:"UNKNOWN"),?28," " S LRURG=+$P(X,U,2) W $E($S($D(^LAB(62.05,LRURG,0)):$P(^(0),U),1:"ROUTINE"),1,15)
|
||
|
|
W ?38," ",$S($D(^LRO(68,+$P(X,"^",4),0)):$P(^(0),"^"),1:""),?50," ",$P(X,"^",5),?55
|
||
|
|
D REF
|
||
|
|
I $P(X,"^",11) W !?3,"Canceled by: "_$P(^VA(200,$P(X,"^",11),0),"^") S I(2)=0 D
|
||
|
|
. F S I(2)=$O(^LRO(69,LRODT,1,LRSN,2,I,1.1,I(2))) Q:I(2)<1 I $D(^(I(2),0)) W !?5,^(0) D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
S I(2)=0 F S I(2)=$O(^LRO(69,LRODT,1,LRSN,2,I,1,I(2))) Q:I(2)<1 I $D(^(I(2),0)) W !?5,^(0) D CHKPAGE Q:$G(LRSTOP)
|
||
|
|
Q
|
||
|
|
REF ; if referred test, display status and manifest
|
||
|
|
N LREVNT,LRMAN,LRUID S LRUID=$P($G(^LRO(69,LRODT,1,LRSN,2,I,.3)),"^") Q:'LRUID
|
||
|
|
W " <"_LRUID_">" S LREVNT=$$STATUS^LREVENT(LRUID,+X,"") I LREVNT'="" D
|
||
|
|
.S LRMAN=$P(LREVNT,"^",3) I LRMAN'="" W !,?5,"SHIPPING MANIFEST: "_LRMAN
|
||
|
|
.W !,?5,"REFERRAL STATUS: "_$P(LREVNT,"^")_" ("_$P(LREVNT,"^",2)_")"
|
||
|
|
Q
|
||
|
|
END ;
|
||
|
|
K %,%DT,A,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,I,II,K,L,LRARIV,LRCLCTR,LRCLST
|
||
|
|
K LRCTYP,LRDRWTM,LRFLAG1,LRFLG,LRLOC,LRMD,LRODT,LROR,LRORD
|
||
|
|
K LRPRAC,LRSN,LRSN1,LRSTOP,LRURG,LRW,LRWHOE,LRWRD,VA("BID"),VA("PID")
|
||
|
|
K VAIN,VADM,VAERR,X,X1,X2,Y,Z
|
||
|
|
Q:$G(LR2ORD)
|
||
|
|
K LRNOP
|
||
|
|
Q
|