- SROCL1 ;BIR/SJA - LOAD CARDIAC LAB DATA ;02/14/07
- ;;3.0; Surgery ;**95,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 the most recent cardiac lab data for tests performed",!,"preoperatively."
- YEP W !!,"Do you want to automatically load cardiac lab data ? YES//" R SRYN:DTIME G:'$T!(SRYN["^") END
- S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter <RET> to automatically load cardiac 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)),U,2) I 'SRAOP S SRAOP=$P($G(^(0)),U,9) I 'SRAOP S SRSOUT=1 W !!,"No Date of Operation found !" G END
- N SREND0,SREND1,SREND1 S SRST=9999999-SRAOP,X1=SRAOP,X2=-90 D C^%DTC S SREND0=9999999-X
- S X1=SRAOP,X2=-30 D C^%DTC S SREND1=9999999-X
- S X1=SRAOP,X2=-1000 D C^%DTC S SREND2=9999999-X
- SRAT ; Get test and data name(s) for test from file 139.2.
- W !!,"..Searching lab record for latest 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
- F SRAT=1,5,7,11,14,21:1:24,27 S SREND=$S("117"[SRAT:SREND1,SRAT>20:SREND2,1:SREND0) D SP^SROAL1
- D CARDIAC^SROAL11 S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON D CONCC
- END I 'SRSOUT W !!,"Press <RET> to continue " R X:DTIME
- W @IOF
- Q
- CONCC ; update concurrent case
- S SRTN1=SRTN,SRTN=SRCON D CARDIAC^SROAL11 S SRTN=SRTN1
- Q
- SP S SRASP=$P(^SRO(139.2,II,2),"^") K SRADT F SRADN=0:0 S SRADN=$O(^SRO(139.2,II,1,SRADN)) Q:SRADN'>0 S SRATN=$P(^(SRADN,0),"^") D LABCHK
- Q
- LABCHK ; Get latest test values from patient's lab record.
- 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
- .I SRSP=SRSER!(SRSP=SRP) D COMP Q
- I '$D(SRAT(SRAT)) S SRAT(SRAT)="NS",SRAD(SRAT)=""
- Q
- COMP S SRX=$P(^LR(SRALR,"CH",SRAIDT,SRATN),"^") I $P(^LR(SRALR,"CH",SRAIDT,0),"^",3)'="","canccommentpending"'[SRX,SRX'["CANC" D DATA
- Q
- DATA I $D(SRADT),SRAIDT>SRADT Q
- I +SRX'=SRX D
- .N X1,X2 S SRZ="" I "<>"[$E(SRX) S SRZ=$E(SRX),SRX=$E(SRX,2,99)
- .I SRX?.N0.1".".N D 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,SRX=SRZ_SRX
- .S SRX="*"
- S SRAT(SRAT)=SRX D:SRAT(SRAT)["." DEC S SRAD(SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7),SRADT=SRAIDT
- Q
- DEC ; convert to proper decimal place
- I +SRAT(SRAT)=SRAT(SRAT) S SRAT(SRAT)=SRAT(SRAT)+.05\.1*.1 Q
- S SR1=$E(SRAT(SRAT)),SR2=$E(SRAT(SRAT),2,99),SR2=SR2+.05\.1*.1,SRAT(SRAT)=SR1_SR2
- Q
- SROCL1 ;BIR/SJA - LOAD CARDIAC LAB DATA ;02/14/07
- +1 ;;3.0; Surgery ;**95,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 the most recent cardiac lab data for tests performed",!,"preoperatively."
- YEP WRITE !!,"Do you want to automatically load cardiac 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 cardiac 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)),U,2)
- IF 'SRAOP
- SET SRAOP=$PIECE($GET(^(0)),U,9)
- IF 'SRAOP
- SET SRSOUT=1
- WRITE !!,"No Date of Operation found !"
- GOTO END
- +2 NEW SREND0,SREND1,SREND1
- SET SRST=9999999-SRAOP
- SET X1=SRAOP
- SET X2=-90
- DO C^%DTC
- SET SREND0=9999999-X
- +3 SET X1=SRAOP
- SET X2=-30
- DO C^%DTC
- SET SREND1=9999999-X
- +4 SET X1=SRAOP
- SET X2=-1000
- DO C^%DTC
- SET SREND2=9999999-X
- SRAT ; Get test and data name(s) for test from file 139.2.
- +1 WRITE !!,"..Searching lab record for latest 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 FOR SRAT=1,5,7,11,14,21:1:24,27
- SET SREND=$SELECT("117"[SRAT:SREND1,SRAT>20:SREND2,1:SREND0)
- DO SP^SROAL1
- +5 DO CARDIAC^SROAL11
- SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")
- IF SRCON
- DO CONCC
- END IF 'SRSOUT
- WRITE !!,"Press <RET> to continue "
- READ X:DTIME
- +1 WRITE @IOF
- +2 QUIT
- CONCC ; update concurrent case
- +1 SET SRTN1=SRTN
- SET SRTN=SRCON
- DO CARDIAC^SROAL11
- SET SRTN=SRTN1
- +2 QUIT
- SP SET SRASP=$PIECE(^SRO(139.2,II,2),"^")
- KILL SRADT
- FOR SRADN=0:0
- SET SRADN=$ORDER(^SRO(139.2,II,1,SRADN))
- IF SRADN'>0
- QUIT
- SET SRATN=$PIECE(^(SRADN,0),"^")
- DO LABCHK
- +1 QUIT
- LABCHK ; Get latest test values from patient's lab record.
- +1 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 SRSP=SRSER!(SRSP=SRP)
- DO COMP
- QUIT
- End DoDot:1
- +3 IF '$DATA(SRAT(SRAT))
- SET SRAT(SRAT)="NS"
- SET SRAD(SRAT)=""
- +4 QUIT
- COMP SET SRX=$PIECE(^LR(SRALR,"CH",SRAIDT,SRATN),"^")
- IF $PIECE(^LR(SRALR,"CH",SRAIDT,0),"^",3)'=""
- IF "canccommentpending"'[SRX
- IF SRX'["CANC"
- DO DATA
- +1 QUIT
- DATA IF $DATA(SRADT)
- IF SRAIDT>SRADT
- QUIT
- +1 IF +SRX'=SRX
- Begin DoDot:1
- +2 NEW X1,X2
- SET SRZ=""
- IF "<>"[$EXTRACT(SRX)
- SET SRZ=$EXTRACT(SRX)
- SET SRX=$EXTRACT(SRX,2,99)
- +3 IF SRX?.N0.1".".N
- Begin DoDot:2
- +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
- SET SRX=SRZ_SRX
- End DoDot:2
- QUIT
- +7 SET SRX="*"
- End DoDot:1
- +8 SET SRAT(SRAT)=SRX
- IF SRAT(SRAT)["."
- DO DEC
- SET SRAD(SRAT)=$EXTRACT($PIECE(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7)
- SET SRADT=SRAIDT
- +9 QUIT
- DEC ; convert to proper decimal place
- +1 IF +SRAT(SRAT)=SRAT(SRAT)
- SET SRAT(SRAT)=SRAT(SRAT)+.05\.1*.1
- QUIT
- +2 SET SR1=$EXTRACT(SRAT(SRAT))
- SET SR2=$EXTRACT(SRAT(SRAT),2,99)
- SET SR2=SR2+.05\.1*.1
- SET SRAT(SRAT)=SR1_SR2
- +3 QUIT
