SROAL1.m

SROAL1 ;BIR/ADM - LOAD PREOPERATIVE LAB DATA ;02/14/07

 ;;3.0; Surgery ;**18,38,47,54,65,71,81,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 the most recent lab data for tests performed",!,"within 90 days before the operation unless otherwise specified."

YEP W !!,"Do you want to automatically load preoperative lab data ?  YES//  " R SRYN:DTIME G:'$T!(SRYN["^") END

 S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter <RET> to automatically load preoperative 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)),"^",2) I 'SRAOP W !!,"The 'Time the Operation Began' must be entered before continuing." D TMCHK G:SRSOUT END

 S SRST=9999999-SRAOP,X1=SRAOP,X2=-90 D C^%DTC S SREND=9999999-X

SRAT ; Get test and data name(s) for test from file 139.2.

 W !!,"..Searching lab record for latest preoperative 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,4,7,8,11,13:1:20,25 D SP

 S SRAT=26,X1=SRAOP,X2=-2 D C^%DTC S SREND=9999999-X D SP

 S SRAT=27,X1=SRAOP,X2=-1000 D C^%DTC S SREND=9999999-X D SP

 I $$LOCK^SROUTL(SRTN) D ^SROAL11 S SRCON=$P($G(^SRF(SRTN,"CON")),"^") D:SRCON CONCC D UNLOCK^SROUTL(SRTN)

END I 'SRSOUT W !!,"Press <RET> to continue  " R X:DTIME

 W @IOF

 Q

CONCC ; update concurrent case

 S SRTN1=SRTN,SRTN=SRCON D N4^SROAL11 S SRTN=SRTN1

 Q

SP S SRASP=$P(^SRO(139.2,SRAT,2),"^") K SRADT F SRADN=0:0 S SRADN=$O(^SRO(139.2,SRAT,1,SRADN)) Q:SRADN'>0  S SRATN=$P(^(SRADN,0),"^") D LABCHK

 D NS

 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 (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

NS ; check for no sample

 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

TMCHK W !!,"Do you want to enter 'Time the Operation Began' at this time ?  YES//  " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q

 S SRYN=$E(SRYN)

 I "YyNn"'[SRYN W !!,"The time that the operation began must be entered prior to capturing the",!,"preoperative lab data.  Enter 'YES' to input 'Time the Operation Began',",!,"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=".22T",DA=SRTN,DIE=130 D ^DIE K DR

 S SRAOP=$P($G(^SRF(SRTN,.2)),"^",2) I 'SRAOP S SRSOUT=1

 Q

DEC ; convert to proper decimal place

 I +SRAT(SRAT)=SRAT(SRAT)  S SRAT(SRAT)=SRAT(SRAT)+.005\.01*.01 Q

 S SR1=$E(SRAT(SRAT)),SR2=$E(SRAT(SRAT),2,99),SR2=SR2+.005\.01*.01,SRAT(SRAT)=SR1_SR2

 Q

CREAT ; from SROACL1 for creatinine

 N SRSER,SRP 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

 S SRLB=0 F SRLB=4,8,20 D

 .S VALUE=$P($G(^SRF(SRTN,201)),"^",SRLB),SRAOPDT=$P(^SRF(SRTN,0),"^",9) I DT>SRAOPDT,VALUE Q

 .S SRSOUT=0,SRALR=$S($D(^DPT($P(^SRF(SRTN,0),"^"),"LR")):$P(^("LR"),"^"),1:"")

 .S SRAOP=SRAOPDT,SRST=9999999-SRAOP,X1=SRAOP,X2=-30 D C^%DTC S SREND=9999999-X

 .S SRAT=$S(SRLB=4:7,SRLB=8:11,1:1),SRASP=$P(^SRO(139.2,SRAT,2),"^") K SRADT F SRADN=0:0 S SRADN=$O(^SRO(139.2,SRAT,1,SRADN)) Q:'SRADN  S SRATN=$P(^(SRADN,0),"^") D LABCHK

 .I $D(SRAT(SRAT)),$$LOCK^SROUTL(SRTN) S $P(^SRF(SRTN,201),"^",SRLB)=SRAT(SRAT),$P(^(202),"^",SRLB)=SRAD(SRAT) D UNLOCK^SROUTL(SRTN)

 K SRLB

 Q

SROAL1    ;BIR/ADM - LOAD PREOPERATIVE LAB DATA ;02/14/07

 +1       ;;3.0; Surgery ;**18,38,47,54,65,71,81,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 the most recent lab data for tests performed",!,"within 90 days before the operation unless otherwise specified."

YEP        WRITE !!,"Do you want to automatically load preoperative 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 preoperative 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)),"^",2)

           IF 'SRAOP

               WRITE !!,"The 'Time the Operation Began' must be entered before continuing."

               DO TMCHK

               IF SRSOUT

                   GOTO END

 +2        SET SRST=9999999-SRAOP

           SET X1=SRAOP

           SET X2=-90

           DO C^%DTC

           SET SREND=9999999-X

SRAT      ; Get test and data name(s) for test from file 139.2.

 +1        WRITE !!,"..Searching lab record for latest preoperative 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,4,7,8,11,13:1:20,25

               DO SP

 +5        SET SRAT=26

           SET X1=SRAOP

           SET X2=-2

           DO C^%DTC

           SET SREND=9999999-X

           DO SP

 +6        SET SRAT=27

           SET X1=SRAOP

           SET X2=-1000

           DO C^%DTC

           SET SREND=9999999-X

           DO SP

 +7        IF $$LOCK^SROUTL(SRTN)

               DO ^SROAL11

               SET SRCON=$PIECE($GET(^SRF(SRTN,"CON")),"^")

               IF SRCON

                   DO CONCC

               DO UNLOCK^SROUTL(SRTN)

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 N4^SROAL11

           SET SRTN=SRTN1

 +2        QUIT 

SP         SET SRASP=$PIECE(^SRO(139.2,SRAT,2),"^")

           KILL SRADT

           FOR SRADN=0:0

               SET SRADN=$ORDER(^SRO(139.2,SRAT,1,SRADN))

               IF SRADN'>0

                   QUIT 

               SET SRATN=$PIECE(^(SRADN,0),"^")

               DO LABCHK

 +1        DO NS

 +2        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 (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

                       End DoDot:1

 +4        QUIT 

NS        ; check for no sample

 +1        IF '$DATA(SRAT(SRAT))

               SET SRAT(SRAT)="NS"

               SET SRAD(SRAT)=""

 +2        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 

TMCHK      WRITE !!,"Do you want to enter 'Time the Operation Began' at this time ?  YES//  "

           READ SRYN:DTIME

           IF '$TEST!(SRYN["^")

               SET SRSOUT=1

               QUIT 

 +1        SET SRYN=$EXTRACT(SRYN)

 +2        IF "YyNn"'[SRYN

               WRITE !!,"The time that the operation began must be entered prior to capturing the",!,"preoperative lab data.  Enter 'YES' to input 'Time the Operation Began',",!,"or 'NO' to return to the menu."

               GOTO TMCHK

 +3        IF "Yy"'[SRYN

               SET SRSOUT=1

               QUIT 

 +4        IF $$LOCK^SROUTL(SRTN)

               Begin DoDot:1

 +5                WRITE !

                   KILL DR

                   SET DR=".22T"

                   SET DA=SRTN

                   SET DIE=130

                   DO ^DIE

                   KILL DR

               End DoDot:1

               DO UNLOCK^SROUTL(SRTN)

 +6        SET SRAOP=$PIECE($GET(^SRF(SRTN,.2)),"^",2)

           IF 'SRAOP

               SET SRSOUT=1

 +7        QUIT 

DEC       ; convert to proper decimal place

 +1        IF +SRAT(SRAT)=SRAT(SRAT)

               SET SRAT(SRAT)=SRAT(SRAT)+.005\.01*.01

               QUIT 

 +2        SET SR1=$EXTRACT(SRAT(SRAT))

           SET SR2=$EXTRACT(SRAT(SRAT),2,99)

           SET SR2=SR2+.005\.01*.01

           SET SRAT(SRAT)=SR1_SR2

 +3        QUIT 

CREAT     ; from SROACL1 for creatinine

 +1        NEW SRSER,SRP

           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

 +2        SET SRLB=0

           FOR SRLB=4,8,20

               Begin DoDot:1

 +3                SET VALUE=$PIECE($GET(^SRF(SRTN,201)),"^",SRLB)

                   SET SRAOPDT=$PIECE(^SRF(SRTN,0),"^",9)

                   IF DT>SRAOPDT

                       IF VALUE

                           QUIT 

 +4                SET SRSOUT=0

                   SET SRALR=$SELECT($DATA(^DPT($PIECE(^SRF(SRTN,0),"^"),"LR")):$PIECE(^("LR"),"^"),1:"")

 +5                SET SRAOP=SRAOPDT

                   SET SRST=9999999-SRAOP

                   SET X1=SRAOP

                   SET X2=-30

                   DO C^%DTC

                   SET SREND=9999999-X

 +6                SET SRAT=$SELECT(SRLB=4:7,SRLB=8:11,1:1)

                   SET SRASP=$PIECE(^SRO(139.2,SRAT,2),"^")

                   KILL SRADT

                   FOR SRADN=0:0

                       SET SRADN=$ORDER(^SRO(139.2,SRAT,1,SRADN))

                       IF 'SRADN

                           QUIT 

                       SET SRATN=$PIECE(^(SRADN,0),"^")

                       DO LABCHK

 +7                IF $DATA(SRAT(SRAT))

                       IF $$LOCK^SROUTL(SRTN)

                           SET $PIECE(^SRF(SRTN,201),"^",SRLB)=SRAT(SRAT)

                           SET $PIECE(^(202),"^",SRLB)=SRAD(SRAT)

                           DO UNLOCK^SROUTL(SRTN)

               End DoDot:1

 +8        KILL SRLB

 +9        QUIT