SROACL2 ;BIR/SJA - CLINICAL DATA ; JULY 12, 2011
;;3.0;Surgery;**125,160,176,182,184,200**;24 Jun 93;Build 9
D HDR^SROAUTL N SRQ
PRIOR W !,"Prior Heart Surgery:"
W !!,"0. NONE 4. OTHER",!,"1. CABG-ONLY 5. CABG/OTHER",!,"2. VALVE-ONLY 6. UNKNOWN",!,"3. CABG/Valve"
K DIR S DIR(0)="LOA^0:6",DIR("A")="Enter your choice(s) separated by commas (0-6): "
I $D(SRAO) S DIR("B")=$S($D(SRAO(X)):$P(SRAO(X),"^"),1:"")
S DIR("?")="Enter applicable types of heart surgery performed."
S DIR("??")="^D H485^SROACL2" D ^DIR K DIR
I X="@" S DIR("A")=" SURE YOU WANT TO DELETE ",DIR(0)="Y" D ^DIR K DIR S:Y X="@" Q
I X=""!(Y["^")!($D(DIRUT)) Q
D CHECK G:SRQ PRIOR
Q
H485 N SRH D HELP^DIE(130,"",485,"A","SRH")
I $G(SRH("DIHELP")) F I=1:1:SRH("DIHELP") W !,?2,SRH("DIHELP",I)
Q
CHECK N I,C S SRQ=0
I Y["0",($TR(Y,",","")>0) S SRQ=1 W !,"Do not enter NONE if prior heart surgeries were performed.",! Q
F I=1:1:$L(Y,",") S C=$P(Y,",",I) Q:C="" W !?43,C," - " D
.I "0123456"[C W $S(C=0:"NONE",C=1:"CABG-ONLY",C=2:"VALVE-ONLY",C=3:"CABG/VALVE",C=4:"OTHER",C=5:"CABG/OTHER",C=6:"UNKNOWN",1:"") Q
S Y=$P(Y,",",1,$L(Y,",")-1)_"^485"
Q
HWT ; retrieve height & weight from vital, called by sromen-start
N SRVAL,SRN0,SRSD,SRED,SRHT,SRHTDT ;SR200: remove 1 year HT limit; update MEASUREMENT DATE (#200.1)
S SRN0=$G(^SRF(SRTN,0)),DFN=$S($D(DFN):DFN,1:$P(SRN0,"^")),SRED=$P(SRN0,"^",9)
H I $P($G(^SRF(SRTN,206)),"^")="" S SRSD=0,SRVAL=$$HW^SROACL1(SRSD,SRED,"HT") D
.I SRVAL'="" S SRHT=$P(SRVAL,U)+.5\1,$P(^SRF(SRTN,206),"^")=SRHT D
..S SRHTDT=$P(SRVAL,U,2) S $P(^SRF(SRTN,200.1),"^",7)=SRHTDT
W I $P($G(^SRF(SRTN,206)),"^",2)="" S SRSD=$$FMADD^XLFDT(SRED,-30),SRVAL=$$HW^SROACL1(SRSD,SRED,"WT") D
.I SRVAL'="" S SRVAL=SRVAL+.5\1,$P(^SRF(SRTN,206),"^",2)=SRVAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROACL2 1849 printed Oct 16, 2024@18:40:47 Page 2
SROACL2 ;BIR/SJA - CLINICAL DATA ; JULY 12, 2011
+1 ;;3.0;Surgery;**125,160,176,182,184,200**;24 Jun 93;Build 9
+2 DO HDR^SROAUTL
NEW SRQ
PRIOR WRITE !,"Prior Heart Surgery:"
+1 WRITE !!,"0. NONE 4. OTHER",!,"1. CABG-ONLY 5. CABG/OTHER",!,"2. VALVE-ONLY 6. UNKNOWN",!,"3. CABG/Valve"
+2 KILL DIR
SET DIR(0)="LOA^0:6"
SET DIR("A")="Enter your choice(s) separated by commas (0-6): "
+3 IF $DATA(SRAO)
SET DIR("B")=$SELECT($DATA(SRAO(X)):$PIECE(SRAO(X),"^"),1:"")
+4 SET DIR("?")="Enter applicable types of heart surgery performed."
+5 SET DIR("??")="^D H485^SROACL2"
DO ^DIR
KILL DIR
+6 IF X="@"
SET DIR("A")=" SURE YOU WANT TO DELETE "
SET DIR(0)="Y"
DO ^DIR
KILL DIR
if Y
SET X="@"
QUIT
+7 IF X=""!(Y["^")!($DATA(DIRUT))
QUIT
+8 DO CHECK
if SRQ
GOTO PRIOR
+9 QUIT
H485 NEW SRH
DO HELP^DIE(130,"",485,"A","SRH")
+1 IF $GET(SRH("DIHELP"))
FOR I=1:1:SRH("DIHELP")
WRITE !,?2,SRH("DIHELP",I)
+2 QUIT
CHECK NEW I,C
SET SRQ=0
+1 IF Y["0"
IF ($TRANSLATE(Y,",","")>0)
SET SRQ=1
WRITE !,"Do not enter NONE if prior heart surgeries were performed.",!
QUIT
+2 FOR I=1:1:$LENGTH(Y,",")
SET C=$PIECE(Y,",",I)
if C=""
QUIT
WRITE !?43,C," - "
Begin DoDot:1
+3 IF "0123456"[C
WRITE $SELECT(C=0:"NONE",C=1:"CABG-ONLY",C=2:"VALVE-ONLY",C=3:"CABG/VALVE",C=4:"OTHER",C=5:"CABG/OTHER",C=6:"UNKNOWN",1:"")
QUIT
End DoDot:1
+4 SET Y=$PIECE(Y,",",1,$LENGTH(Y,",")-1)_"^485"
+5 QUIT
HWT ; retrieve height & weight from vital, called by sromen-start
+1 ;SR200: remove 1 year HT limit; update MEASUREMENT DATE (#200.1)
NEW SRVAL,SRN0,SRSD,SRED,SRHT,SRHTDT
+2 SET SRN0=$GET(^SRF(SRTN,0))
SET DFN=$SELECT($DATA(DFN):DFN,1:$PIECE(SRN0,"^"))
SET SRED=$PIECE(SRN0,"^",9)
H IF $PIECE($GET(^SRF(SRTN,206)),"^")=""
SET SRSD=0
SET SRVAL=$$HW^SROACL1(SRSD,SRED,"HT")
Begin DoDot:1
+1 IF SRVAL'=""
SET SRHT=$PIECE(SRVAL,U)+.5\1
SET $PIECE(^SRF(SRTN,206),"^")=SRHT
Begin DoDot:2
+2 SET SRHTDT=$PIECE(SRVAL,U,2)
SET $PIECE(^SRF(SRTN,200.1),"^",7)=SRHTDT
End DoDot:2
End DoDot:1
W IF $PIECE($GET(^SRF(SRTN,206)),"^",2)=""
SET SRSD=$$FMADD^XLFDT(SRED,-30)
SET SRVAL=$$HW^SROACL1(SRSD,SRED,"WT")
Begin DoDot:1
+1 IF SRVAL'=""
SET SRVAL=SRVAL+.5\1
SET $PIECE(^SRF(SRTN,206),"^",2)=SRVAL
End DoDot:1
+2 QUIT
