| 1 | SROCL1 ;BIR/SJA - LOAD CARDIAC LAB DATA ;02/14/07
 | 
|---|
| 2 |  ;;3.0; Surgery ;**95,125,153,160**;24 Jun 93;Build 7
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^LR( supported by DBIA #194
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  Q:'$D(SRTN)  N SRBLUD K SRAD,SRAT S SRSOUT=0
 | 
|---|
| 7 |  W !!,"This selection loads the most recent cardiac lab data for tests performed",!,"preoperatively."
 | 
|---|
| 8 | YEP W !!,"Do you want to automatically load cardiac lab data ?  YES//" R SRYN:DTIME G:'$T!(SRYN["^") END
 | 
|---|
| 9 |  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
 | 
|---|
| 10 |  I "Yy"'[SRYN W !!,"Lab data NOT loaded." G END
 | 
|---|
| 11 | START S SRALR=$S($D(^DPT($P(^SRF(SRTN,0),"^"),"LR")):$P(^("LR"),"^"),1:"")
 | 
|---|
| 12 |  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
 | 
|---|
| 13 |  N SREND0,SREND1,SREND1 S SRST=9999999-SRAOP,X1=SRAOP,X2=-90 D C^%DTC S SREND0=9999999-X
 | 
|---|
| 14 |  S X1=SRAOP,X2=-30 D C^%DTC S SREND1=9999999-X
 | 
|---|
| 15 |  S X1=SRAOP,X2=-1000 D C^%DTC S SREND2=9999999-X
 | 
|---|
| 16 | SRAT ; Get test and data name(s) for test from file 139.2.
 | 
|---|
| 17 |  W !!,"..Searching lab record for latest test data...."
 | 
|---|
| 18 |  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
 | 
|---|
| 19 |  K DIC S DIC=61,DIC(0)="",X="BLOOD" D ^DIC S SRBLUD=+Y
 | 
|---|
| 20 |  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
 | 
|---|
| 21 |  D CARDIAC^SROAL11 S SRCON=$P($G(^SRF(SRTN,"CON")),"^") I SRCON D CONCC
 | 
|---|
| 22 | END I 'SRSOUT W !!,"Press <RET> to continue  " R X:DTIME
 | 
|---|
| 23 |  W @IOF
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 | CONCC ; update concurrent case
 | 
|---|
| 26 |  S SRTN1=SRTN,SRTN=SRCON D CARDIAC^SROAL11 S SRTN=SRTN1
 | 
|---|
| 27 |  Q
 | 
|---|
| 28 | 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
 | 
|---|
| 29 |  Q
 | 
|---|
| 30 | LABCHK ; Get latest test values from patient's lab record.
 | 
|---|
| 31 |  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
 | 
|---|
| 32 |  .I SRSP=SRSER!(SRSP=SRP) D COMP Q
 | 
|---|
| 33 |  I '$D(SRAT(SRAT)) S SRAT(SRAT)="NS",SRAD(SRAT)=""
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 | COMP S SRX=$P(^LR(SRALR,"CH",SRAIDT,SRATN),"^") I $P(^LR(SRALR,"CH",SRAIDT,0),"^",3)'="","canccommentpending"'[SRX,SRX'["CANC" D DATA
 | 
|---|
| 36 |  Q
 | 
|---|
| 37 | DATA I $D(SRADT),SRAIDT>SRADT Q
 | 
|---|
| 38 |  I +SRX'=SRX D
 | 
|---|
| 39 |  .N X1,X2 S SRZ="" I "<>"[$E(SRX) S SRZ=$E(SRX),SRX=$E(SRX,2,99)
 | 
|---|
| 40 |  .I SRX?.N0.1".".N D  Q
 | 
|---|
| 41 |  ..S X1=$P(SRX,"."),X1=+X1 S:X1=0 X1=""
 | 
|---|
| 42 |  ..S X2="."_$P(SRX,".",2),X2=+X2 S:X2=0 X2=""
 | 
|---|
| 43 |  ..S SRX=X1_X2,SRX=+SRX,SRX=SRZ_SRX
 | 
|---|
| 44 |  .S SRX="*"
 | 
|---|
| 45 |  S SRAT(SRAT)=SRX D:SRAT(SRAT)["." DEC S SRAD(SRAT)=$E($P(^LR(SRALR,"CH",SRAIDT,0),"^"),1,7),SRADT=SRAIDT
 | 
|---|
| 46 |  Q
 | 
|---|
| 47 | DEC ; convert to proper decimal place
 | 
|---|
| 48 |  I +SRAT(SRAT)=SRAT(SRAT)  S SRAT(SRAT)=SRAT(SRAT)+.05\.1*.1 Q
 | 
|---|
| 49 |  S SR1=$E(SRAT(SRAT)),SR2=$E(SRAT(SRAT),2,99),SR2=SR2+.05\.1*.1,SRAT(SRAT)=SR1_SR2
 | 
|---|
| 50 |  Q
 | 
|---|