SROAL11 ;BIR/ADM - LOAD PREOP LAB DATA (CONTINUED) ;06/27/06
;;3.0; Surgery ;**38,47,65,95,125,153,160,174**;24 Jun 93;Build 8
STUFF ; Transfer test data from array to file 130
W !!,"..Moving preoperative lab test data to Surgery Risk Assessment file...."
N4 I $D(SRAT(4)) S X=SRAT(4),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^")=X S $P(^(202),"^")=$S(X'="":SRAD(4),1:"") ; Sodium
N7 I $D(SRAT(7)) S X=SRAT(7),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",4)=X,$P(^(202),"^",4)=$S(X'="":SRAD(7),1:"") ; Creatinine
N8 I $D(SRAT(8)) S X=SRAT(8),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",5)=X,$P(^(202),"^",5)=$S(X'="":SRAD(8),1:"") ; BUN
N11 I $D(SRAT(11)) S X=SRAT(11),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",8)=X,$P(^(202),"^",8)=$S(X'="":SRAD(11),1:"") ; Albumin
N13 I $D(SRAT(13)) S X=SRAT(13),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",11)=X,$P(^(202),"^",11)=$S(X'="":SRAD(13),1:"") ; SGOT
N14 I $D(SRAT(14)) S X=SRAT(14),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",9)=X,$P(^(202),"^",9)=$S(X'="":SRAD(14),1:"") ; Total Bilirubin
N15 I $D(SRAT(15)) S X=SRAT(15),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",12)=X,$P(^(202),"^",12)=$S(X'="":SRAD(15),1:"") ; Alkaline Phosphatase
N16 I $D(SRAT(16)) S X=SRAT(16),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",13)=X,$P(^(202),"^",13)=$S(X'="":SRAD(16),1:"") ; White Blood Count
N17 I $D(SRAT(17)) S X=SRAT(17),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",14)=X,$P(^(202),"^",14)=$S(X'="":SRAD(17),1:"") ; Hematocrit
N18 I $D(SRAT(18)) S X=SRAT(18),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",15)=X,$P(^(202),"^",15)=$S(X'="":SRAD(18),1:"") ; Platelet Count
N19 I $D(SRAT(19)) S X=SRAT(19),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",17)=X,$P(^(202),"^",17)=$S(X'="":SRAD(19),1:"") ; PT
N20 I $D(SRAT(20)) S X=SRAT(20),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",16)=X,$P(^(202),"^",16)=$S(X'="":SRAD(20),1:"") ; PTT
N25 I $D(SRAT(25)) S X=SRAT(25),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,201),"^",27)=X,$P(^(202),"^",27)=$S(X'="":SRAD(25),1:"") ; INR
N26 I $D(SRAT(26)) S X=SRAT(26),SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",15)=X,$P(^(204),"^",15)=$S(X'="":SRAD(26),1:"") ; ANION GAP
N27 I $D(SRAT(27)) S X=SRAT(27),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",28)=X,$P(^(202.1),"^")=$S(X'="":SRAD(27),1:"") ; HEMOGLOBIN A1C
Q
CARDIAC ; LOAD CARDIAC LAB DATA (CONTINUED)
N SRCRD
C1 I $D(SRAT(1)) S X=SRAT(1),SRL=1,SRH=7,SRCRD=1 D INPUT S $P(^SRF(SRTN,201),"^",20)=X,$P(^(202),"^",20)=$S(X'="":SRAD(1),1:"") ; Hemoglobin
C5 I $D(SRAT(5)) S X=SRAT(5),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",23)=X,$P(^(202),"^",23)=$S(X'="":SRAD(5),1:"") ; Potassium (Cardiac)
C7 I $D(SRAT(7)) S X=SRAT(7),SRL=1,SRH=4,SRCRD=1 D INPUT S $P(^SRF(SRTN,201),"^",4)=X,$P(^(202),"^",4)=$S(X'="":SRAD(7),1:"") ; Creatinine
C11 I $D(SRAT(11)) S X=SRAT(11),SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,201),"^",8)=X,$P(^(202),"^",8)=$S(X'="":SRAD(11),1:"") ; Albumin
C14 I $D(SRAT(14)) S X=SRAT(14),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",24)=X,$P(^(202),"^",24)=$S(X'="":SRAD(14),1:"") ; Total Bilirubin (Cardiac)
C21 I $D(SRAT(21)) S X=SRAT(21),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",21)=X,$P(^(202),"^",21)=$S(X'="":SRAD(21),1:"") ; HDL
C22 I $D(SRAT(22)) S X=SRAT(22),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",22)=X,$P(^(202),"^",22)=$S(X'="":SRAD(22),1:"") ; Triglyceride
C23 I $D(SRAT(23)) S X=SRAT(23),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",25)=X,$P(^(202),"^",25)=$S(X'="":SRAD(23),1:"") ; LDL
C24 I $D(SRAT(24)) S X=SRAT(24),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",26)=X,$P(^(202),"^",26)=$S(X'="":SRAD(24),1:"") ; Cholesterol
C27 I $D(SRAT(27)) S X=SRAT(27),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",28)=X,$P(^(202.1),"^")=$S(X'="":SRAD(27),1:"") ; HEMOGLOBIN A1C
C28 I $D(SRAT(28)) S X=SRAT(28),SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,201),"^",29)=X,$P(^(202.1),"^",2)=$S(X'="":SRAD(28),1:"") ; B-type Natriuretic Peptide (BNP)
Q
INPUT ; input checking
N SRX,SRY I $D(SRCRD),X="NS" S X=""
K SRCRD I X="NS"!(X="") Q
I $L(X)<SRL S X="" Q
S SRX=X,SRY="" S:" <>"[$E(X) SRY=$E(X),SRX=$E(X,2,99)
I +SRX'=SRX S X="" Q
I $L(X)>SRH D
.I SRX["." S SRX=SRX+.05\.1*.1,X=SRY_SRX I $L(X)>SRH S SRX=SRX+.5\1,X=SRY_SRX
.I $L(X)>SRH S X=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROAL11 4225 printed Apr 09, 2024@21:43:19 Page 2
SROAL11 ;BIR/ADM - LOAD PREOP LAB DATA (CONTINUED) ;06/27/06
+1 ;;3.0; Surgery ;**38,47,65,95,125,153,160,174**;24 Jun 93;Build 8
STUFF ; Transfer test data from array to file 130
+1 WRITE !!,"..Moving preoperative lab test data to Surgery Risk Assessment file...."
N4 ; Sodium
IF $DATA(SRAT(4))
SET X=SRAT(4)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^")=X
SET $PIECE(^(202),"^")=$SELECT(X'="":SRAD(4),1:"")
N7 ; Creatinine
IF $DATA(SRAT(7))
SET X=SRAT(7)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",4)=X
SET $PIECE(^(202),"^",4)=$SELECT(X'="":SRAD(7),1:"")
N8 ; BUN
IF $DATA(SRAT(8))
SET X=SRAT(8)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",5)=X
SET $PIECE(^(202),"^",5)=$SELECT(X'="":SRAD(8),1:"")
N11 ; Albumin
IF $DATA(SRAT(11))
SET X=SRAT(11)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",8)=X
SET $PIECE(^(202),"^",8)=$SELECT(X'="":SRAD(11),1:"")
N13 ; SGOT
IF $DATA(SRAT(13))
SET X=SRAT(13)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",11)=X
SET $PIECE(^(202),"^",11)=$SELECT(X'="":SRAD(13),1:"")
N14 ; Total Bilirubin
IF $DATA(SRAT(14))
SET X=SRAT(14)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",9)=X
SET $PIECE(^(202),"^",9)=$SELECT(X'="":SRAD(14),1:"")
N15 ; Alkaline Phosphatase
IF $DATA(SRAT(15))
SET X=SRAT(15)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",12)=X
SET $PIECE(^(202),"^",12)=$SELECT(X'="":SRAD(15),1:"")
N16 ; White Blood Count
IF $DATA(SRAT(16))
SET X=SRAT(16)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",13)=X
SET $PIECE(^(202),"^",13)=$SELECT(X'="":SRAD(16),1:"")
N17 ; Hematocrit
IF $DATA(SRAT(17))
SET X=SRAT(17)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",14)=X
SET $PIECE(^(202),"^",14)=$SELECT(X'="":SRAD(17),1:"")
N18 ; Platelet Count
IF $DATA(SRAT(18))
SET X=SRAT(18)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",15)=X
SET $PIECE(^(202),"^",15)=$SELECT(X'="":SRAD(18),1:"")
N19 ; PT
IF $DATA(SRAT(19))
SET X=SRAT(19)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",17)=X
SET $PIECE(^(202),"^",17)=$SELECT(X'="":SRAD(19),1:"")
N20 ; PTT
IF $DATA(SRAT(20))
SET X=SRAT(20)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",16)=X
SET $PIECE(^(202),"^",16)=$SELECT(X'="":SRAD(20),1:"")
N25 ; INR
IF $DATA(SRAT(25))
SET X=SRAT(25)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",27)=X
SET $PIECE(^(202),"^",27)=$SELECT(X'="":SRAD(25),1:"")
N26 ; ANION GAP
IF $DATA(SRAT(26))
SET X=SRAT(26)
SET SRL=1
SET SRH=5
DO INPUT
SET $PIECE(^SRF(SRTN,203),"^",15)=X
SET $PIECE(^(204),"^",15)=$SELECT(X'="":SRAD(26),1:"")
N27 ; HEMOGLOBIN A1C
IF $DATA(SRAT(27))
SET X=SRAT(27)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",28)=X
SET $PIECE(^(202.1),"^")=$SELECT(X'="":SRAD(27),1:"")
+1 QUIT
CARDIAC ; LOAD CARDIAC LAB DATA (CONTINUED)
+1 NEW SRCRD
C1 ; Hemoglobin
IF $DATA(SRAT(1))
SET X=SRAT(1)
SET SRL=1
SET SRH=7
SET SRCRD=1
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",20)=X
SET $PIECE(^(202),"^",20)=$SELECT(X'="":SRAD(1),1:"")
C5 ; Potassium (Cardiac)
IF $DATA(SRAT(5))
SET X=SRAT(5)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",23)=X
SET $PIECE(^(202),"^",23)=$SELECT(X'="":SRAD(5),1:"")
C7 ; Creatinine
IF $DATA(SRAT(7))
SET X=SRAT(7)
SET SRL=1
SET SRH=4
SET SRCRD=1
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",4)=X
SET $PIECE(^(202),"^",4)=$SELECT(X'="":SRAD(7),1:"")
C11 ; Albumin
IF $DATA(SRAT(11))
SET X=SRAT(11)
SET SRL=1
SET SRH=4
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",8)=X
SET $PIECE(^(202),"^",8)=$SELECT(X'="":SRAD(11),1:"")
C14 ; Total Bilirubin (Cardiac)
IF $DATA(SRAT(14))
SET X=SRAT(14)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",24)=X
SET $PIECE(^(202),"^",24)=$SELECT(X'="":SRAD(14),1:"")
C21 ; HDL
IF $DATA(SRAT(21))
SET X=SRAT(21)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",21)=X
SET $PIECE(^(202),"^",21)=$SELECT(X'="":SRAD(21),1:"")
C22 ; Triglyceride
IF $DATA(SRAT(22))
SET X=SRAT(22)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",22)=X
SET $PIECE(^(202),"^",22)=$SELECT(X'="":SRAD(22),1:"")
C23 ; LDL
IF $DATA(SRAT(23))
SET X=SRAT(23)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",25)=X
SET $PIECE(^(202),"^",25)=$SELECT(X'="":SRAD(23),1:"")
C24 ; Cholesterol
IF $DATA(SRAT(24))
SET X=SRAT(24)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",26)=X
SET $PIECE(^(202),"^",26)=$SELECT(X'="":SRAD(24),1:"")
C27 ; HEMOGLOBIN A1C
IF $DATA(SRAT(27))
SET X=SRAT(27)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",28)=X
SET $PIECE(^(202.1),"^")=$SELECT(X'="":SRAD(27),1:"")
C28 ; B-type Natriuretic Peptide (BNP)
IF $DATA(SRAT(28))
SET X=SRAT(28)
SET SRL=1
SET SRH=6
DO INPUT
SET $PIECE(^SRF(SRTN,201),"^",29)=X
SET $PIECE(^(202.1),"^",2)=$SELECT(X'="":SRAD(28),1:"")
+1 QUIT
INPUT ; input checking
+1 NEW SRX,SRY
IF $DATA(SRCRD)
IF X="NS"
SET X=""
+2 KILL SRCRD
IF X="NS"!(X="")
QUIT
+3 IF $LENGTH(X)<SRL
SET X=""
QUIT
+4 SET SRX=X
SET SRY=""
if " <>"[$EXTRACT(X)
SET SRY=$EXTRACT(X)
SET SRX=$EXTRACT(X,2,99)
+5 IF +SRX'=SRX
SET X=""
QUIT
+6 IF $LENGTH(X)>SRH
Begin DoDot:1
+7 IF SRX["."
SET SRX=SRX+.05\.1*.1
SET X=SRY_SRX
IF $LENGTH(X)>SRH
SET SRX=SRX+.5\1
SET X=SRY_SRX
+8 IF $LENGTH(X)>SRH
SET X=""
End DoDot:1
+9 QUIT
