SROAL2 ;BIR/ADM - LOAD POSTOPERATIVE LAB DATA ;02/14/07
;;3.0; Surgery ;**18,38,47,54,65,71,88,100,125,153,160**;24 Jun 93;Build 7
;
; Reference to ^LR( supported by DBIA #194
;
Q:'$D(SRTN) N SRBLUD K SRAD,SRAT S SRSOUT=0
W !!,"This selection loads highest or lowest lab data for tests performed within",!,"30 days after the operation."
YEP W !!,"Do you want to automatically load postoperative lab data ? YES// " R SRYN:DTIME G:'$T!(SRYN["^") END
S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter <RET> to automatically load postoperative lab data from the patient's lab record, or 'NO' to return to the menu." G YEP
I "Yy"'[SRYN W !!,"Lab data NOT loaded." G END
START S SRALR=$S($D(^DPT($P(^SRF(SRTN,0),"^"),"LR")):$P(^("LR"),"^"),1:"")
S SRAOP=$P($G(^SRF(SRTN,.2)),"^",3) I 'SRAOP W !!,"'Time the Operation Ends' must be entered before continuing." D TMCHK G:SRSOUT END
S SREND=9999999-SRAOP,X1=SRAOP,X2=30 D C^%DTC S SRST=9999999-X
SRAT ; Get test from file 139.2.
W !!,"..Searching lab record for postoperative lab test data...."
K DIC S DIC=61,DIC(0)="",X="SERUM" D ^DIC S SRSER=+Y K DIC S DIC=61,DIC(0)="",X="PLASMA" D ^DIC K DIC S SRP=+Y
K DIC S DIC=61,DIC(0)="",X="BLOOD" D ^DIC S SRBLUD=+Y
S SRFLG="H" F SRAT=2,3,4,5,7,9,10,14,16,26 S SRASP=$P(^SRO(139.2,SRAT,2),"^") D SRADN,NS
S SRFLG="L" F SRAT=4,5,17 S SRASP=$P(^SRO(139.2,SRAT,2),"^") D SRADN,NS
I $$LOCK^SROUTL(SRTN) D ^SROAL21,UNLOCK^SROUTL(SRTN)
END I 'SRSOUT W !!,"Press <RET> to continue " R X:DTIME
W @IOF
Q
SRADN ; Get data name(s) for test, make call to check lab record.
F SRADN=0:0 S SRADN=$O(^SRO(139.2,SRAT,1,SRADN)) Q:SRADN'>0 S SRATN=$P(^(SRADN,0),"^") D LABCHK
Q
LABCHK ; Get test values from patient's lab record.
S SRX="" I SRALR F SRAIDT=SRST:0 S SRAIDT=$O(^LR(SRALR,"CH",SRAIDT)) Q:SRAIDT'>0!(SRAIDT>SREND) I $D(^(SRAIDT,SRATN)) S SRSP=$P(^(0),"^",5) D Q:(SRFLG="H"&(SRX[">"))!(SRFLG="L"&(SRX["<")) I SRX="*" D STAR
.I (SRAT>1&(SRAT<16))!(SRAT=26)!(SRAT>20&(SRAT<25)),SRSP=SRSER!(SRSP=SRP)!(SRSP=SRBLUD) D COMP Q
.I SRSP=SRASP D COMP Q
Q
COMP S SRAVAL=$P(^LR(SRALR,"CH",SRAIDT,SRATN),"^") I $P(^LR(SRALR,"CH",SRAIDT,0),"^",3)'="","canccommentpending"'[SRAVAL,SRAVAL'["CANC" D DATA
I $D(SRAT(SRFLG,SRAT)),SRAT(SRFLG,SRAT)["." D
.I SRAT(SRFLG,SRAT)=+SRAT(SRFLG,SRAT) S SRAT(SRFLG,SRAT)=SRAT(SRFLG,SRAT)+.005\.01*.01 Q
.S SR1=$E(SRAT(SRFLG,SRAT)),SR2=$E(SRAT(SRFLG,SRAT),2,99),SR2=SR2+.005\.01*.01,SRAT(SRFLG,SRAT)=SR1_SR2
Q
NS ; check for no sample
I '$D(SRAT(SRFLG,SRAT)) S SRAT(SRFLG,SRAT)="NS",SRAD(SRFLG,SRAT)=""
Q
STAR ; questional result, require manual input
S (SRAT(SRFLG,SRAT),SRAD(SRFLG,SRAT))=""
Q
DATA ; Decide to save test result or not
N SRSWAP,SRVAL S SRSWAP=0
S (SRT,SRX)=SRAVAL I +SRAVAL'=SRAVAL D CONV Q:SRX="*" S (SRT,SRAVAL)=SRZ_SRX
I $D(SRAT(SRFLG,SRAT)) S SRT1=SRAT(SRFLG,SRAT) D I SRSWAP S SRAT(SRFLG,SRAT)=SRAVAL,SRAD(SRFLG,SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7) Q
.I SRFLG="H" Q:SRT1[">" D
..I SRT[">" S SRSWAP=1 Q
..S SRVAL=SRX,SRX=SRT1 D CONV I SRVAL>SRX S SRSWAP=1 Q
.I SRFLG="L" Q:SRT1["<" D
..I SRT["<" S SRSWAP=1 Q
..S SRVAL=SRX,SRX=SRT1 D CONV I SRVAL<SRX S SRSWAP=1 Q
I '$D(SRAT(SRFLG,SRAT)) S SRAT(SRFLG,SRAT)=SRAVAL,SRAD(SRFLG,SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7)
Q
TMCHK W !!,"Do you want to enter the time that the operation was completed at ",!,"this time ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to input 'Time the Operation Ends' or ",!,"'NO' to return to the menu." G TMCHK
I "Yy"'[SRYN S SRSOUT=1 Q
I $$LOCK^SROUTL(SRTN) D D UNLOCK^SROUTL(SRTN)
.W ! K DR S DR=".23T",DA=SRTN,DIE=130 D ^DIE K DR S SRAOP=$P($G(^SRF(SRTN,.2)),"^",3) I 'SRAOP S SRSOUT=1
Q
CONV ; convert value to numeric for comparison
N SRELSE,X1,X2 S SRZ="" I " <>"[$E(SRX) S SRZ=$E(SRX),SRX=$E(SRX,2,99)
I SRX?.N0.1".".N D Q
.I SRX'["." S SRX=+SRX Q
.S X1=$P(SRX,"."),X1=+X1 S:X1=0 X1=""
.S X2="."_$P(SRX,".",2),X2=+X2 S:X2=0 X2=""
.S SRX=X1_X2,SRX=+SRX
S SRX="*"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAL2 4071 printed Nov 22, 2024@17:50:31 Page 2
SROAL2 ;BIR/ADM - LOAD POSTOPERATIVE LAB DATA ;02/14/07
+1 ;;3.0; Surgery ;**18,38,47,54,65,71,88,100,125,153,160**;24 Jun 93;Build 7
+2 ;
+3 ; Reference to ^LR( supported by DBIA #194
+4 ;
+5 if '$DATA(SRTN)
QUIT
NEW SRBLUD
KILL SRAD,SRAT
SET SRSOUT=0
+6 WRITE !!,"This selection loads highest or lowest lab data for tests performed within",!,"30 days after the operation."
YEP WRITE !!,"Do you want to automatically load postoperative lab data ? YES// "
READ SRYN:DTIME
if '$TEST!(SRYN["^")
GOTO END
+1 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
WRITE !!,"Enter <RET> to automatically load postoperative lab data from the patient's lab record, or 'NO' to return to the menu."
GOTO YEP
+2 IF "Yy"'[SRYN
WRITE !!,"Lab data NOT loaded."
GOTO END
START SET SRALR=$SELECT($DATA(^DPT($PIECE(^SRF(SRTN,0),"^"),"LR")):$PIECE(^("LR"),"^"),1:"")
+1 SET SRAOP=$PIECE($GET(^SRF(SRTN,.2)),"^",3)
IF 'SRAOP
WRITE !!,"'Time the Operation Ends' must be entered before continuing."
DO TMCHK
if SRSOUT
GOTO END
+2 SET SREND=9999999-SRAOP
SET X1=SRAOP
SET X2=30
DO C^%DTC
SET SRST=9999999-X
SRAT ; Get test from file 139.2.
+1 WRITE !!,"..Searching lab record for postoperative lab test data...."
+2 KILL DIC
SET DIC=61
SET DIC(0)=""
SET X="SERUM"
DO ^DIC
SET SRSER=+Y
KILL DIC
SET DIC=61
SET DIC(0)=""
SET X="PLASMA"
DO ^DIC
KILL DIC
SET SRP=+Y
+3 KILL DIC
SET DIC=61
SET DIC(0)=""
SET X="BLOOD"
DO ^DIC
SET SRBLUD=+Y
+4 SET SRFLG="H"
FOR SRAT=2,3,4,5,7,9,10,14,16,26
SET SRASP=$PIECE(^SRO(139.2,SRAT,2),"^")
DO SRADN
DO NS
+5 SET SRFLG="L"
FOR SRAT=4,5,17
SET SRASP=$PIECE(^SRO(139.2,SRAT,2),"^")
DO SRADN
DO NS
+6 IF $$LOCK^SROUTL(SRTN)
DO ^SROAL21
DO UNLOCK^SROUTL(SRTN)
END IF 'SRSOUT
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+1 WRITE @IOF
+2 QUIT
SRADN ; Get data name(s) for test, make call to check lab record.
+1 FOR SRADN=0:0
SET SRADN=$ORDER(^SRO(139.2,SRAT,1,SRADN))
if SRADN'>0
QUIT
SET SRATN=$PIECE(^(SRADN,0),"^")
DO LABCHK
+2 QUIT
LABCHK ; Get test values from patient's lab record.
+1 SET SRX=""
IF SRALR
FOR SRAIDT=SRST:0
SET SRAIDT=$ORDER(^LR(SRALR,"CH",SRAIDT))
if SRAIDT'>0!(SRAIDT>SREND)
QUIT
IF $DATA(^(SRAIDT,SRATN))
SET SRSP=$PIECE(^(0),"^",5)
Begin DoDot:1
+2 IF (SRAT>1&(SRAT<16))!(SRAT=26)!(SRAT>20&(SRAT<25))
IF SRSP=SRSER!(SRSP=SRP)!(SRSP=SRBLUD)
DO COMP
QUIT
+3 IF SRSP=SRASP
DO COMP
QUIT
End DoDot:1
if (SRFLG="H"&(SRX[">"))!(SRFLG="L"&(SRX["<"))
QUIT
IF SRX="*"
DO STAR
+4 QUIT
COMP SET SRAVAL=$PIECE(^LR(SRALR,"CH",SRAIDT,SRATN),"^")
IF $PIECE(^LR(SRALR,"CH",SRAIDT,0),"^",3)'=""
IF "canccommentpending"'[SRAVAL
IF SRAVAL'["CANC"
DO DATA
+1 IF $DATA(SRAT(SRFLG,SRAT))
IF SRAT(SRFLG,SRAT)["."
Begin DoDot:1
+2 IF SRAT(SRFLG,SRAT)=+SRAT(SRFLG,SRAT)
SET SRAT(SRFLG,SRAT)=SRAT(SRFLG,SRAT)+.005\.01*.01
QUIT
+3 SET SR1=$EXTRACT(SRAT(SRFLG,SRAT))
SET SR2=$EXTRACT(SRAT(SRFLG,SRAT),2,99)
SET SR2=SR2+.005\.01*.01
SET SRAT(SRFLG,SRAT)=SR1_SR2
End DoDot:1
+4 QUIT
NS ; check for no sample
+1 IF '$DATA(SRAT(SRFLG,SRAT))
SET SRAT(SRFLG,SRAT)="NS"
SET SRAD(SRFLG,SRAT)=""
+2 QUIT
STAR ; questional result, require manual input
+1 SET (SRAT(SRFLG,SRAT),SRAD(SRFLG,SRAT))=""
+2 QUIT
DATA ; Decide to save test result or not
+1 NEW SRSWAP,SRVAL
SET SRSWAP=0
+2 SET (SRT,SRX)=SRAVAL
IF +SRAVAL'=SRAVAL
DO CONV
if SRX="*"
QUIT
SET (SRT,SRAVAL)=SRZ_SRX
+3 IF $DATA(SRAT(SRFLG,SRAT))
SET SRT1=SRAT(SRFLG,SRAT)
Begin DoDot:1
+4 IF SRFLG="H"
if SRT1[">"
QUIT
Begin DoDot:2
+5 IF SRT[">"
SET SRSWAP=1
QUIT
+6 SET SRVAL=SRX
SET SRX=SRT1
DO CONV
IF SRVAL>SRX
SET SRSWAP=1
QUIT
End DoDot:2
+7 IF SRFLG="L"
if SRT1["<"
QUIT
Begin DoDot:2
+8 IF SRT["<"
SET SRSWAP=1
QUIT
+9 SET SRVAL=SRX
SET SRX=SRT1
DO CONV
IF SRVAL<SRX
SET SRSWAP=1
QUIT
End DoDot:2
End DoDot:1
IF SRSWAP
SET SRAT(SRFLG,SRAT)=SRAVAL
SET SRAD(SRFLG,SRAT)=$EXTRACT($PIECE(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7)
QUIT
+10 IF '$DATA(SRAT(SRFLG,SRAT))
SET SRAT(SRFLG,SRAT)=SRAVAL
SET SRAD(SRFLG,SRAT)=$EXTRACT($PIECE(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7)
+11 QUIT
TMCHK WRITE !!,"Do you want to enter the time that the operation was completed at ",!,"this time ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to input 'Time the Operation Ends' or ",!,"'NO' to return to the menu."
GOTO TMCHK
+2 IF "Yy"'[SRYN
SET SRSOUT=1
QUIT
+3 IF $$LOCK^SROUTL(SRTN)
Begin DoDot:1
+4 WRITE !
KILL DR
SET DR=".23T"
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DR
SET SRAOP=$PIECE($GET(^SRF(SRTN,.2)),"^",3)
IF 'SRAOP
SET SRSOUT=1
End DoDot:1
DO UNLOCK^SROUTL(SRTN)
+5 QUIT
CONV ; convert value to numeric for comparison
+1 NEW SRELSE,X1,X2
SET SRZ=""
IF " <>"[$EXTRACT(SRX)
SET SRZ=$EXTRACT(SRX)
SET SRX=$EXTRACT(SRX,2,99)
+2 IF SRX?.N0.1".".N
Begin DoDot:1
+3 IF SRX'["."
SET SRX=+SRX
QUIT
+4 SET X1=$PIECE(SRX,".")
SET X1=+X1
if X1=0
SET X1=""
+5 SET X2="."_$PIECE(SRX,".",2)
SET X2=+X2
if X2=0
SET X2=""
+6 SET SRX=X1_X2
SET SRX=+SRX
End DoDot:1
QUIT
+7 SET SRX="*"
+8 QUIT
