- 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 Jan 18, 2025@03:41:18 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