Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROACL2

SROACL2.m

Go to the documentation of this file.
  1. SROACL2 ;BIR/SJA - CLINICAL DATA ; JULY 12, 2011
  1. ;;3.0;Surgery;**125,160,176,182,184,200**;24 Jun 93;Build 9
  1. D HDR^SROAUTL N SRQ
  1. PRIOR W !,"Prior Heart Surgery:"
  1. W !!,"0. NONE 4. OTHER",!,"1. CABG-ONLY 5. CABG/OTHER",!,"2. VALVE-ONLY 6. UNKNOWN",!,"3. CABG/Valve"
  1. K DIR S DIR(0)="LOA^0:6",DIR("A")="Enter your choice(s) separated by commas (0-6): "
  1. I $D(SRAO) S DIR("B")=$S($D(SRAO(X)):$P(SRAO(X),"^"),1:"")
  1. S DIR("?")="Enter applicable types of heart surgery performed."
  1. S DIR("??")="^D H485^SROACL2" D ^DIR K DIR
  1. I X="@" S DIR("A")=" SURE YOU WANT TO DELETE ",DIR(0)="Y" D ^DIR K DIR S:Y X="@" Q
  1. I X=""!(Y["^")!($D(DIRUT)) Q
  1. D CHECK G:SRQ PRIOR
  1. Q
  1. H485 N SRH D HELP^DIE(130,"",485,"A","SRH")
  1. I $G(SRH("DIHELP")) F I=1:1:SRH("DIHELP") W !,?2,SRH("DIHELP",I)
  1. Q
  1. CHECK N I,C S SRQ=0
  1. I Y["0",($TR(Y,",","")>0) S SRQ=1 W !,"Do not enter NONE if prior heart surgeries were performed.",! Q
  1. F I=1:1:$L(Y,",") S C=$P(Y,",",I) Q:C="" W !?43,C," - " D
  1. .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
  1. S Y=$P(Y,",",1,$L(Y,",")-1)_"^485"
  1. Q
  1. HWT ; retrieve height & weight from vital, called by sromen-start
  1. N SRVAL,SRN0,SRSD,SRED,SRHT,SRHTDT ;SR200: remove 1 year HT limit; update MEASUREMENT DATE (#200.1)
  1. S SRN0=$G(^SRF(SRTN,0)),DFN=$S($D(DFN):DFN,1:$P(SRN0,"^")),SRED=$P(SRN0,"^",9)
  1. H I $P($G(^SRF(SRTN,206)),"^")="" S SRSD=0,SRVAL=$$HW^SROACL1(SRSD,SRED,"HT") D
  1. .I SRVAL'="" S SRHT=$P(SRVAL,U)+.5\1,$P(^SRF(SRTN,206),"^")=SRHT D
  1. ..S SRHTDT=$P(SRVAL,U,2) S $P(^SRF(SRTN,200.1),"^",7)=SRHTDT
  1. W I $P($G(^SRF(SRTN,206)),"^",2)="" S SRSD=$$FMADD^XLFDT(SRED,-30),SRVAL=$$HW^SROACL1(SRSD,SRED,"WT") D
  1. .I SRVAL'="" S SRVAL=SRVAL+.5\1,$P(^SRF(SRTN,206),"^",2)=SRVAL
  1. Q