279 lines
9.1 KiB
Mathematica
279 lines
9.1 KiB
Mathematica
LRVER5 ;DALOI/CJS/DALOI/FHS - LAB ROUTINE DATA VERIFICATION ;2/7/91 12:04
|
|
;;5.2;LAB SERVICE;**42,153,283,286**;Sep 27, 1994
|
|
;
|
|
I $G(LRNDISP) D
|
|
. S LRNX=0
|
|
. N LRX F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 S LRX(LRORD(LRNX))=""
|
|
. S LRX=0 F S LRX=$O(LRSB(LRX)) Q:LRX<1 K:'$D(LRX(LRX)) LRSB(LRX),LRSA(LRX)
|
|
;
|
|
; Check for amended results that have arrived via an HL7 interface.
|
|
; Only allow amended results to be verified during this session.
|
|
I $D(^LAH("LA7 AMENDED RESULTS",LRUID)) D
|
|
. S LRNX=0
|
|
. F S LRNX=$O(LRORD(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRORD(LRNX))) K LRORD(LRNX)
|
|
. S LRNX=0
|
|
. F S LRNX=$O(LRSB(LRNX)) Q:'LRNX I '$D(^LAH("LA7 AMENDED RESULTS",LRUID,LRNX)) K LRSB(LRNX),LRSA(LRNX)
|
|
;
|
|
S LRNX=0,LRVRM=12
|
|
;
|
|
V40 S LRNX=$O(LRORD(LRNX)) G V44:LRNX<1 D LRSUBS
|
|
;
|
|
; Check if changing performing lab.
|
|
I $P($G(LRSB(LRSB)),"^",9),'$$PLOK^LRVERA($P(LRSB(LRSB),"^",9),$G(LRDUZ(2)),DUZ(2),LRTS) G V40
|
|
;
|
|
D V25
|
|
;
|
|
V42 ;
|
|
;
|
|
S (LRDL,SX,X)=$P($G(LRSB(LRSB)),U),LRDVF=0,LREDIT=0
|
|
S:X=""&(LRDV'="") X=LRDV,LRDVF=1 ; default value
|
|
S LRTEST=$P(^LAB(60,LRTS,0),U)
|
|
K LRNOVER(LRSB)
|
|
;
|
|
Q42 ;
|
|
;
|
|
; Check for amended results that have arrived via an HL7 interface.
|
|
I $D(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB)) D G:SX'=X!($G(LRAMEND(LRSB))) V45
|
|
. W !,LRTEST," " W:X'="" @LRFP
|
|
. D AMEND Q:$G(LRAMEND(LRSB))
|
|
. I SX=X W !,LRTEST," " W:X'="" @LRFP
|
|
;
|
|
; If entering results from a reference lab and not using normal/units
|
|
; from file #60 then ask user for these values otherwise display
|
|
; current file #60 values.
|
|
I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2) D
|
|
. I $G(^LAB(60,+LRTS,1,+$G(LRSPEC),.1)) D Q
|
|
. . D V25
|
|
. . W !!,"Current Ref Range: ",LRNG2,"-",LRNG3," Units: ",$P(LRNG,"^",7)
|
|
. . I LRNG4="",LRNG5="" Q
|
|
. . W !," Critical Low: ",LRNG4," Critical High: ",LRNG5
|
|
. N LRX,LRY
|
|
. D ASKPLNR,NORM
|
|
. S LRX=$P(LRNGS,"^",2,5),LRX=$TR(LRX,"^","!")
|
|
. S LRY=$P($G(LRSB(LRSB)),"^",5),$P(LRY,"!",2,5)=LRX
|
|
. S $P(LRSB(LRSB),"^",5)=LRY
|
|
;
|
|
W !,LRTEST," " W:X'="" @LRFP
|
|
R "//",X:DTIME
|
|
I X'?.ANP W $C(7)," No Control Characters allowed." G V42
|
|
S:$L($G(SX))&(X="") X=SX,LRDVF=1
|
|
S LRDL=X I X=""&LRDVF S (LRD,X)=LRDV G V45
|
|
Q43 G V40:X="",V45:X'["^",V44:X="^",LROUT:X="^^"
|
|
;
|
|
V43 S X=$P(X,U,2),DIC="^LAB(60,",DIC(0)="EOQZ" D ^DIC G:Y<1 Q42
|
|
S LRPLOC=$P(Y(0),U,5),LRSSQ=$P(LRPLOC,";",1),LRSB=$P(LRPLOC,";",2),LRTS=+Y
|
|
I LRSSQ="" W !,"Not in this group" G LROUT
|
|
I LRSS'=LRSSQ!'$D(^TMP("LR",$J,"TMP",LRSB)) W !,"Not in this group" G LROUT
|
|
S LRNX=0
|
|
F S LRNX=$O(LRORD(LRNX)) Q:LRNX<1 Q:LRSB=LRORD(LRNX)
|
|
I LRNX,LRSB=LRORD(LRNX) D LRSUBS,V25 G V42
|
|
;
|
|
V44 K SX
|
|
D COM^LRVER4
|
|
S LRNUF=1 S:LRVF LRSA=1
|
|
Q
|
|
;
|
|
V45 ;
|
|
K LRSKIP
|
|
I X="@" D G V46
|
|
. K:'$G(LRVF) ^LR(LRDFN,LRSS,LRIDT,LRSB)
|
|
. S X=$S($G(LRVF)&($D(LRSB(LRSB)))&('$D(LRM(LRSB))):"comment",$D(LRM(LRSB)):"pending",$D(LRSA(LRSB)):"canc",1:"")
|
|
. S $P(LRSB(LRSB),"^")=X,$P(LRSB(LRSB),"^",2)=""
|
|
;
|
|
S LRXD=U_$P(^LAB(60,LRTS,0),U,12),LRXDP=LRXD_"0)",LRXDP=@LRXDP
|
|
X:'(X="*"!($E(X)="?")!(X="C")!(X="#")!(X="canc")!(X="pending")) $P(LRXDP,U,5,99)
|
|
I '$D(X)#2 D HELP G V42
|
|
I $D(X)#2,X["?" D HELP G:'($P(LRXDP,U,2)["S") V42
|
|
I $D(X)#2,$P(LRXDP,U,2)["S",X'="*",X'="#",X'="canc",X'="pending" D LRSET G:'$D(X)#2 V42
|
|
I $D(X)#2,X="C",$P(LRXDP,U,2)'["S" D COMP G V42
|
|
;
|
|
V46 ;
|
|
G V42:'$D(X)#2
|
|
I LRVF,$D(LRSB(LRSB)),$D(LRSA(LRSB)) S LRSA(LRSB,1)=LRTEST
|
|
S X1=$S($D(^LR(LRDFN,LRSS,+LRLDT,LRSB)):$P(^(LRSB),U),1:"")
|
|
S:X="*" X="canc" S:X="#" X="comment"
|
|
;
|
|
I '$G(LRAMEND(LRSB)) S LRFLG=""
|
|
S Y=0 X:LRDEL'="" LRDEL
|
|
I '$G(LRAMEND(LRSB)) D RANGE^LRVER4
|
|
;
|
|
S:$P(X,U)="" $P(LRSB(LRSB),U)=""
|
|
I $P(X,U)'="" D
|
|
. S $P(LRSB(LRSB),U)=X,$P(LRSB(LRSB),U,2)=LRFLG
|
|
. S LRX=$$TMPSB^LRVER1(LRSB),LRY=$P(LRSB(LRSB),U,3)
|
|
. F I=1:1:$L(LRX,"!") I $P(LRY,"!",I)="" S $P(LRY,"!",I)=$P(LRX,"!",I)
|
|
. S $P(LRSB(LRSB),U,3)=LRY
|
|
. I $P($P(LRSB(LRSB),U,3),"!")="" D RONLT^LRVER3
|
|
. D
|
|
. . I '$D(LRSA(LRSB))#2 D Q
|
|
. . . S $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
|
|
. . . S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2)))
|
|
. . S:'$P(LRSB(LRSB),U,4) $P(LRSB(LRSB),U,4)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
|
|
. S $P(LRSB(LRSB),U,5)=$TR(LRNGS,U,"!")
|
|
. S $P(LRSB(LRSB),U,9)=$S($G(LRDUZ(2)):LRDUZ(2),1:$G(DUZ(2)))
|
|
G:$D(LRNUF) V44 K LRNUF G V40:'$D(LRSKIP) S X=LRSKIP G Q43:X["^",V40
|
|
;
|
|
;
|
|
RANGE ;
|
|
S $P(LRSB(LRSB),"^")=X
|
|
; If previous results from another laboratory then use normals and units
|
|
; associated with those results.
|
|
D
|
|
. I $G(LRDUZ(2)),DUZ(2)'=LRDUZ(2) D PLNR^LRVR4 Q
|
|
. I $P(LRSB(LRSB),"^",9),DUZ(2)'=$P(LRSB(LRSB),"^",9) D PLNR^LRVR4
|
|
D RANGE^LRVER4
|
|
Q
|
|
;
|
|
;
|
|
LRSUBS ; From LRVR5
|
|
S LRSB=LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB))#2:^(LRSB),1:0)
|
|
Q
|
|
;
|
|
;
|
|
LRSET ; from above and LRVR5
|
|
;
|
|
N I,LRERR,RESULT
|
|
D CHK^DIE(63.04,LRSB,"EH",X,.RESULT,"LRERR")
|
|
;
|
|
I RESULT'="^" S X=RESULT W " ",RESULT(0)
|
|
;
|
|
I RESULT="^" D
|
|
. F I=1:1:LRERR("DIHELP") W !,LRERR("DIHELP",I)
|
|
. K X
|
|
;
|
|
Q
|
|
;
|
|
;
|
|
COMP ; from LRVR5
|
|
S X="^%ET",@^%ZOSF("TRAP")
|
|
R !,"Enter your computation: ",C:DTIME
|
|
Q:"^"[C G CH:C="?"!(C["""") S C=$P(C," ",1)
|
|
S X="TRAP^LRVER5",@^%ZOSF("TRAP") D ^DIM S X="W "_C
|
|
I '$D(X)#2 W !,"Something's wrong with the syntax." G CH
|
|
F I=1:1:$L(C) I $E(C,I)?1A S I=.9 Q
|
|
G CH:I=.9,CH:C["/0",CH:C["\0" W !," equals ",@C G COMP
|
|
TRAP ;
|
|
W !!,"Error in your mathematical formular ",!
|
|
CH W !,"Enter for example: 5*2/4+1 and 3.5 will be returned [i.e. ((5*2)/4)+1=3.5]"
|
|
G COMP
|
|
;
|
|
;
|
|
V25 ; From LRVER4
|
|
N LRTX,LRX
|
|
S (LRDV,LRNG,LRDEL,LRNGS)=""
|
|
I '$D(^LAB(60,+LRTS,0))#2 Q
|
|
S LRX=+$P($P(^LAB(60,+LRTS,0),U,5),";",2)
|
|
S LRTX=$S($L($P(^LAB(60,+LRTS,0),U,5)):$O(^LAB(60,"C",$P(^LAB(60,+LRTS,0),U,5),0)),1:+LRTS)
|
|
S LRFP=$P(^LAB(60,LRTX,.1),U,3)
|
|
I LRFP="" S LRFP="$J(X,8)"
|
|
;
|
|
; Normal ranges, units, delta checks and default value
|
|
I $D(^LAB(60,LRTX,1,+$G(LRSPEC),0)) D
|
|
. S LRNG=^LAB(60,LRTX,1,+$G(LRSPEC),0)
|
|
. S LRDEL=$G(^LAB(62.1,+$P(LRNG,U,8),1))
|
|
. S LRDEL(1)=$G(^LAB(62.1,+$P(LRNG,U,8),2),"Q")
|
|
. S X2=$P(LRNG,U,9)
|
|
. S LRDV=$S('$D(LRSB(LRX)):$P(LRNG,U,10),1:"")
|
|
;
|
|
; When entering results from a reference lab check if flag to use normals/units from file 60.
|
|
I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),'$G(^LAB(60,LRTX,1,+$G(LRSPEC),.1)) D PLNR^LRVR4
|
|
;
|
|
NORM ;
|
|
I $G(SEX)="" S SEX="M"
|
|
I $G(AGE)="" S AGE=99
|
|
S LRNGS=LRNG
|
|
F LRX=2:1:5 D
|
|
. N LRY
|
|
. S LRY=$P(LRNG,"^",LRX)
|
|
. ; enclose in quotes if text or structured numeric
|
|
. I LRY'="",$E(LRY)?.(1A,1"<",1">") S LRY=$C(34)_LRY_$C(34)
|
|
. I LRY'="",$E(LRY)'=$C(34),LRY'?.N.1".".N S @("LRY"_"="_LRY)
|
|
. S $P(LRNG,"^",LRX)=LRY,$P(LRNGS,"^",LRX)=LRY,@("LRNG"_LRX)=LRY
|
|
Q
|
|
;
|
|
;
|
|
LROUT ;
|
|
K SX
|
|
S LROUT=1
|
|
Q
|
|
;
|
|
;
|
|
HELP W !," ??",$C(7) S LRXDH=LRXD_"3)"
|
|
W:$D(@LRXDH) " ",@LRXDH
|
|
W !,"Enter * to report ""canc"" for canceled."
|
|
W !,"Enter # to report ""comment""."
|
|
W:'($P(LRXDP,U,2)["S") !,"Enter C to enter calculate mode."
|
|
Q
|
|
;
|
|
;
|
|
AMEND ; Process amended results and prompt user
|
|
N LRANS,LRLL,LRSQ,LRROOT,LRX
|
|
; flag to indicate if amended results have been extracted from LAH
|
|
S LRAMEND=0
|
|
; save current value of X
|
|
S LRX=X
|
|
S LRROOT=$Q(^LAH("LA7 AMENDED RESULTS",LRUID,LRSB))
|
|
I LRROOT="" Q
|
|
I $QS(LRROOT,1)'="LA7 AMENDED RESULTS"!($QS(LRROOT,2)'=LRUID)!($QS(LRROOT,3)'=LRSB) Q
|
|
S LRLL=$QS(LRROOT,4),LRSQ=$QS(LRROOT,5)
|
|
I $D(^LAH(LRLL,1,LRSQ,LRSB)) D
|
|
. N DIR,DIRUT,DTOUT,DUOUT,LRJ,LRY,X,Y
|
|
. S LRY=^LAH(LRLL,1,LRSQ,LRSB)
|
|
. S DIR(0)="SOA^0:No;1:Yes;2:Keep but do not process",DIR("B")="Yes"
|
|
. S DIR("A",1)=" ",DIR("A",2)="Amended result: "_$P(LRY,"^")
|
|
. S DIR("A",2)=DIR("A",2)_" flag: "_$S($P(LRY,"^",2)'="":$P(LRY,"^",2),1:"None")
|
|
. S DIR("A",2)=DIR("A",2)_" units: "_$P($P(LRY,"^",5),"!",7)
|
|
. S DIR("A")="Accept amended results: "
|
|
. S DIR("?",1)="Answer with 0-No to not accept amended result and delete.",DIR("?",2)="1-Yes to process amended result.",DIR("?")="or 2-Keep which skips processing but leaves result for future processing."
|
|
. D ^DIR
|
|
. I $D(DIRUT) Q
|
|
. S LRANS=Y
|
|
. I LRANS=2 Q
|
|
. I LRANS=1 D
|
|
. . S LRX=$P(LRY,"^"),LRFLG=$P(LRY,"^",2),LRSB(LRSB)=LRY,LRJ=$P(LRY,"^",5)
|
|
. . F LRI=1,2,3,4,5,7,11,12 S $P(LRNG,"^",LRI)=$P(LRJ,"!",LRI)
|
|
. . S LRNGS=LRNG,(LRAMEND,LRAMEND(LRSB))=1
|
|
. . D LRSBCOM^LRVR4 ; also process any comments
|
|
. K ^LAH(LRLL,1,LRSQ,LRSB)
|
|
. K ^LAH("LA7 AMENDED RESULTS",LRUID,LRSB,LRLL,LRSQ)
|
|
. I +$O(^LAH(LRLL,1,LRSQ,1))<1 D ZAPALL^LRVR3(LRLL,LRSQ)
|
|
S X=LRX
|
|
Q
|
|
;
|
|
;
|
|
ASKPLNR ; Ask user for performing lab normal ranges and units when entering
|
|
; manually and not using values from file #60.
|
|
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRI,LRJ,LRX,LRY,Y,X,Y
|
|
;
|
|
S LRX=$P($G(LRSB(LRSB)),"^",5)
|
|
;
|
|
W !!,"For test ",LRTEST
|
|
S DIR(0)="60.01,6"
|
|
I $P(LRX,"!",7)'="" S DIR("B")=$P(LRX,"!",7)
|
|
D ^DIR
|
|
I $D(DTOUT)!($D(DUOUT)) Q
|
|
; Set units into component 7 of piece 5
|
|
S $P(LRX,"!",7)=Y,$P(LRSB(LRSB),"^",5)=LRX
|
|
;
|
|
; Ask normals - high/low and critical
|
|
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|
F LRJ=1,2,3,4 D Q:$D(DTOUT)!($D(DUOUT))
|
|
. K DIR
|
|
. S DIR(0)="60.01,"_LRJ,LRI=LRJ+1
|
|
. I $P(LRX,"!",LRI)'="" D
|
|
. . S DIR("B")=$P(LRX,"!",LRI)
|
|
. . I $E(DIR("B"))=$C(34) Q
|
|
. . I DIR("B")'?.N.1".".N S DIR("B")=$C(34)_DIR("B")_$C(34) ; enclose in quotes if text
|
|
. D ^DIR
|
|
. I $D(DTOUT)!($D(DUOUT)) Q
|
|
. S $P(LRX,"!",LRI)=Y
|
|
;
|
|
; Ask user for normality in case user does not know high/low/critical.
|
|
S LRRFLAG(LRSB)=$$RFLAG^LRVERA($P($G(LRSB(LRSB)),"^",2))
|
|
;
|
|
; Update normal variable LRNG
|
|
I $P(LRX,"!")="" S $P(LRX,"!")=LRSPEC
|
|
F LRI=1,2,3,4,5,7 S $P(LRNG,"^",LRI)=$P(LRX,"!",LRI)
|
|
;
|
|
Q
|