- 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 Mar 13, 2025@21:45:43 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
