- SROATCM1 ;BIR/MAM - STUFF TRANMISSION IN ^TMP ;09/28/2011
- ;;3.0;Surgery;**38,71,79,90,88,93,95,111,125,135,134,142,153,160,174,175,176,177,182,184,200**;24 Jun 93;Build 9
- K SRA F I=0,.2,52,200,201,202,205:1:208,207.1,209,202.1,200.1,"1.0",210,211,"VERD" S SRA(I)=$G(^SRF(SRTN,I))
- S DFN=$P(SRA(0),"^") N I D DEM^VADPT S SRANAME=VADM(1),SEX=$P(VADM(5),"^"),Z=$P(VADM(3),"^"),SRSDATE=$P(SRA(0),"^",9),Y=$E(SRSDATE,1,7),AGE=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7))
- N SRPID S SRPID=VA("PID"),SRPID=$TR(SRPID,"-","") ; remove hyphens from PID
- N SROBOT S SROBOT=$P($G(^SRF(SRTN,"OP")),U,3),SHEMP="{"_$J(SRASITE,3)_$J(SRTN,7)_" 1 "_DT_$J(AGE,3)_$J(SEX,1)_$J(SRSDATE,12,4)_$J(SRPID,21)_$J($P($G(SRA(208)),"^",11),2)_$J(SROBOT,2)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 2 ",SRACNT=SRACNT+1
- S SRHD=$P(SRA(206),"^")
- I SRHD["C" S SRH="C",SRHD=$E(SRHD,1,$L(SRHD)-1)
- E S SRH=" "
- S SRWD=$P(SRA(206),"^",2)
- I SRWD["K" S SRW="K",SRWD=$E(SRWD,1,$L(SRWD)-1)
- E S SRW=" "
- S SHEMP=SHEMP_$J(SRHD,3)_SRH_$J(SRWD,3)_SRW_$J($P(SRA(200),"^",2),2)_$J($P(SRA(200),"^",11),2)_$J($P(SRA(206),"^",5),3)_$J($P(SRA(206),"^",6),2)_$J($P(SRA(206),"^",7),2)
- S SRCT=$P($G(^SRF(SRTN,201)),"^",4) S:SRCT["NS" SRCT=""
- S SHEMP=SHEMP_$J($P(SRA(200.1),"^",5),2)_$J(SRCT,4)_$J($P(SRA(206),"^",10),2)_$J($P(SRA(206),"^",11),2)_$J($P(SRA(200),"^",8),2)_$J($P(SRA(200.1),"^",2),2)_$J($P(SRA(206),"^",14),2)_$J(" ",2)
- S SHEMP=SHEMP_$J($P(SRA(206),"^",16),2)_$J($P(SRA(206),"^",17),2)_$J($P(SRA(206),"^",18),3)_$J($P(SRA(206),"^",19),3)_$J($P(SRA(206),"^",20),2)_$J($P(SRA(206),"^",21),2)_$J($P(SRA(206),"^",22),2)_$J($P(SRA(206),"^",23),2)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP_$J($P(SRA(208),"^",19),2)_$J($P(SRA(205),"^",8),2)_$J($P(SRA(205),"^",6),2)_$J($P(SRA(200),"^",59),1)_$J($P(SRA(207),"^",29),2)_$J($P(SRA(0),"^",26),1)
- ;
- S SHEMP=$E(SHEMP,1,11)_" 3 ",SRACNT=SRACNT+1
- S SHEMP=SHEMP_$J($P(SRA(206),"^",24),2)_$J($P(SRA(206),"^",25),3)_$J($P(SRA(206),"^",26),3)_$J($P(SRA(206),"^",27),3)
- ; Left Main (node 3 pos 26-28), LAD (node 3 pos 29-31), Right Coronary (node 3 pos 32-34) & Circumflex Stenosis (node 3 pos 35-37)
- S SHEMP=SHEMP_$J($P(SRA(206),"^",28),3)_$J($P($G(SRA(206)),"^",33),3)_$J($P($G(SRA(206)),"^",34),3)_$J($P($G(SRA(206)),"^",35),3)
- ; LV Cont Grade (node 3 pos 39-40) & Mitral Regurgitation(node 3 pos 41-42)
- N SROLV S SROLV=$P(SRA(206),"^",30)
- S SHEMP=SHEMP_$J($S(SROLV="IIIa":"3A",SROLV="IIIb":"3B",1:SROLV),3)_$J($P($G(SRA(206)),"^",9),2)
- ; Estimate of Mortality and ASA Class are changed to not transmit "NS"
- S SREMDATE=$P($G(SRA(206)),"^",32)
- S SREMO=$P($G(^SRF(SRTN,206)),"^",31) S:SREMO["NS" SREMDATE=""
- ; Estimate of Mortality (node 3 pos 43-45) & date (node 3 pos 46-57)
- S SHEMP=SHEMP_$J(SREMO,3)
- S SHEMP=SHEMP_$S(SREMDATE="":$J(SREMDATE,12),1:$J(SREMDATE,12,4))
- S X="",Y=$P($G(^SRF(SRTN,1.1)),"^",3) S:Y X=$P($P($G(^SRO(132.8,Y,0)),"^"),"-") S X=$E(X) S:X["N" X=""
- S SHEMP=SHEMP_$J(X,1)
- ; Cardiac Est. of Surg. Priority(node 3 pos 59) & date(node 3 pos 60-71)
- S SHEMP=SHEMP_$J($P($G(SRA(208)),"^",12),1)
- N SREMSPDT S SREMSPDT=$P($G(SRA(208)),"^",13)
- S SHEMP=SHEMP_$S(SREMSPDT="":$J(SREMSPDT,12),1:$J(SREMSPDT,12,4))_$J($P(SRA("1.0"),"^",8),2)_$J($P(SRA(210),"^",14),2)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 4 ",SRACNT=SRACNT+1
- S SHEMP=SHEMP_$J($P(SRA(207),"^"),2)_$J($P(SRA(207),"^",2),2)_$J($P(SRA(207),"^",3),2)_$J($P(SRA(207),"^",4),2)_$J($P(SRA(207),"^",5),2)_$J(" ",2)_$J($P(SRA(207),"^",7),2)
- S SHEMP=SHEMP_$J($P(SRA(207),"^",8),2)_$J($P(SRA(207),"^",9),2)_$J($P(SRA(207),"^",10),2)_$J($P(SRA(207),"^",12),2)_$J($P(SRA(207),"^",13),2)_$J($P(SRA(207),"^",14),2)_$J($P(SRA(207),"^",15),2)
- S SHEMP=SHEMP_$J($P(SRA(207),"^",16),2)_$J($P(SRA(207),"^",17),2)_$J($P(SRA(207),"^",18),2)_" "
- S SRDEATH=$P($G(SRA(208)),"^"),SRDDATE=$E($P($G(^DPT(DFN,.35)),"^"),1,12) I SRDDATE'="" S SRDDATE=$$LJ^XLFSTR(SRDDATE,12,0)
- S SHEMP=SHEMP_$J($P(SRA(205),"^",41),2)_$J(SRDDATE,12)
- N SRDIS S SRDIS=$P($G(^SRF(SRTN,.4)),"^",6) S:SRDIS SRDIS=$P($G(^SRO(131.6,SRDIS,0)),"^",2)
- S SHEMP=SHEMP_$J($P(SRA(207),"^",20),1)_$J($P(SRA(207),"^",28),2)_$J($P(SRA(200.1),"^",8),1)_$J(SRDIS,3)
- S SRA(200.1)=$G(^SRF(SRTN,200.1)) S SHEMP=SHEMP_$J($P(SRA(200.1),U,15),1)_$J($P(SRA(210),"^",5),2)_$J($P(SRA(210),"^",6),2)_$J($P(SRA(210),"^",8),2)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 5 ",SRACNT=SRACNT+1
- N SROR S SROR="",Y=$P(^SRF(SRTN,0),"^",2),C=$P(^DD(130,.02,0),"^",2) I Y'="" D Y^DIQ S SROR=Y
- S SHEMP=SHEMP_$J($E(SROR,1,30),30) F I=1:1:6 S SHEMP=SHEMP_$J($P(SRA(52),"^",I),2)
- S SHEMP=SHEMP_$J($P(SRA(200),"^",55),2) F I=9:1:14 S SHEMP=SHEMP_$J($P(SRA(200.1),"^",I),2)
- S SHEMP=SHEMP_$J($P(SRA(210),"^",9),2)_$J($P(SRA(210),"^",12),2)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 6 ",SRACNT=SRACNT+1
- S SHEMP=SHEMP_$J($P(SRA(205),"^",27),2)_$J($P(SRA(208),"^",3),2)_$J($P(SRA(205),"^",17),2)_$J($P(SRA(208),"^",4),2)_$J($P(SRA(208),"^",5),2)_$J($P(SRA(205),"^",28),2)_$J($P(SRA(208),"^",6),2)
- N SRRCS D RCSP S SHEMP=SHEMP_$J($P(SRA(205),"^",13),2)_$J(SRRCS,2)_$J($P(SRA(205),"^",22),2)
- N SRCVA D CVA S SHEMP=SHEMP_$J(SRCVA,2)
- N SRIP D CPR S SHEMP=SHEMP_$J(SRIP,2)
- ;
- ;Ethnicity contained in VADM(11)
- N SROETCD,SROPTF S SROETCD="",SROPTF=""
- S SROETCD=$P($G(VADM(11,1)),U,1) ;Ethnicity code
- S SROPTF=$$PTR2CODE^DGUTL4(SROETCD,2,4) ;PTF Ethnicity code
- S SHEMP=SHEMP_$J($G(SROPTF),1) ;Ethnicity
- ;
- ;Multiple races contained in VADM(12)
- N SRORAC,SRORCD,SRORCE S SRORCE=0,SRORAC="",SRORACE="",SRORCD=""
- F S SRORCE=$O(VADM(12,SRORCE)) Q:SRORCE="" D
- .S SRORAC=$P($G(VADM(12,SRORCE)),U,1) ;Race code
- .S SRORCD=$$PTR2CODE^DGUTL4(SRORAC,1,4) ;PTF race code
- .S SRORACE=SRORACE_$J(SRORCD,1)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP_SRORACE ;Eth, race added
- S SHEMP=$E(SHEMP,1,11)_" 7 ",SRACNT=SRACNT+1
- S SHEMP=SHEMP_$TR(SRANAME,","," ")
- I $P($G(^SRF(SRTN,"RA")),"^",3)=1 S SHEMP=SHEMP_$J("***RE-TRANSMISSION",38)
- ; zip code, employ status, hemoglobin, hemo date, serum albumin, albumin date, creatitine date, total ischemic time, min invasive, total cpb time, total pre,post ICU & step down unit LOS,
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 8 ",SRACNT=SRACNT+1
- K VADM D ADD^VADPT S X=$S($P(VAPA(11),"^",2)'="":$P(VAPA(11),"^",2),1:VAPA(6))
- S SHEMP=SHEMP_$J(X,10)_$J($P(SRA(208),"^",18),1)_$J($P(SRA(201),"^",20),7)_$J($P(SRA(202),"^",20),7)_$J($P(SRA(201),"^",8),4)_$J($P(SRA(202),"^",8),7)_$J($P(SRA(202),"^",4),7)_$J($P(SRA(206),"^",36),4)
- S SHEMP=SHEMP_$J($P(SRA(207),"^",22),1)_$J($P(SRA(206),"^",37),4)_$J($P(SRA(207),"^",23),2)
- ; cpt codes
- NODE9 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 9 ",SRACNT=SRACNT+1
- S SRPMOD="",SR10SP=" ",CPT=$P($G(^SRO(136,SRTN,0)),"^",2) D
- .I CPT S CPT=$P($$CPT^ICPTCOD(CPT),"^",2),SRCASE=SRTN D MOD^SROATM3 S SRPMOD=SRM
- .S SHEMP=SHEMP_$J(CPT,5),SRPMOD=SRPMOD_SR10SP
- K CPT F I=1:1:10 S (CPT(I),SRMOD(I))=""
- S (OPS,CNT)=0 F S OPS=$O(^SRO(136,SRTN,3,OPS)) Q:'OPS!(CNT=10) S CNT=CNT+1,X=$P($G(^SRO(136,SRTN,3,OPS,0)),"^") I X S CPT(CNT)=$P($$CPT^ICPTCOD(X),"^",2) D OTH^SROATM3
- S SHEMP=SHEMP_$J(CPT(1),5)_$J(CPT(2),5)_$J(CPT(3),5)_$J(CPT(4),5)_$J(CPT(5),5)_$J(CPT(6),5)_$J(CPT(7),5)_$J(CPT(8),5)_$J(CPT(9),5)_$J(CPT(10),5)
- ; card cath date, admission date/time, hospital discharge date/time, anesthesia start & end date/times
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 10",SRACNT=SRACNT+1
- I $P(SRA(207),"^",21)'="" D
- .I $E($P(SRA(207),"^",21),8)="." Q
- .E S $P(SRA(207),"^",21)=$P(SRA(207),"^",21)_"."
- S $P(SRA(207),"^",21)=$$LJ^XLFSTR($P(SRA(207),"^",21),12,0)
- S SHEMP=SHEMP_$J($E($P(SRA(207),"^",21),1,12),12)
- S (SRDATE,SRI)="" F SRI=14,15 S SRDATE=$E($P($G(SRA(208)),"^",SRI),1,12) S SRDATE=$$LJ^XLFSTR(SRDATE,12,0) S SHEMP=SHEMP_SRDATE
- S (SRDATE,SRI)="" F SRI=1,4 S SRDATE=$P(SRA(.2),"^",SRI) S SRDATE=$$LJ^XLFSTR(SRDATE,12,0) S SHEMP=SHEMP_SRDATE
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 11",SRACNT=SRACNT+1
- S (SRDATE,SRI)="" F SRI=10,12,2,3 S SRDATE=$P(SRA(.2),"^",SRI),SRDATE=$$LJ^XLFSTR(SRDATE,12,0) S SHEMP=SHEMP_SRDATE
- ; preop risk factors comments
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 12",SRACNT=SRACNT+1 S SHEMP=SHEMP_$TR($E($G(^SRF(SRTN,206.1)),1,65),",","^")
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 13",SRACNT=SRACNT+1 S SHEMP=SHEMP_$TR($E($G(^SRF(SRTN,206.1)),66,130),",","^")
- ; resource data comments
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 14",SRACNT=SRACNT+1 S SHEMP=SHEMP_$TR($E($G(^SRF(SRTN,206.2)),1,65),",","^")
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 15",SRACNT=SRACNT+1 S SHEMP=SHEMP_$TR($E($G(^SRF(SRTN,206.2)),66,130),",","^")
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1,SHEMP=$E(SHEMP,1,11)_" 16"_$E(SRPMOD,1,10) F I=1:1:5 S SHEMP=SHEMP_$E(SRMOD(I)_SR10SP,1,10)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1,SHEMP=$E(SHEMP,1,11)_" 17" F I=6:1:10 S SHEMP=SHEMP_$E(SRMOD(I)_SR10SP,1,10)
- S X=$$SITE^SROUTL0(SRTN),SRDIV=$S(X:$P(^SRO(133,X,0),"^"),1:""),SRDIV=$S(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE),SHEMP=SHEMP_$J(SRDIV,6)
- S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
- Q
- RCSP S SRRCS=0,X=$P(SRA(208),"^",7) I X="N" Q
- N SROCC S SROCC=0 F S SROCC=$O(^SRF(SRTN,16,SROCC)) Q:'SROCC I $P(^SRF(SRTN,16,SROCC,0),"^",2)=27 S X=$P(^SRF(SRTN,16,SROCC,0),"^",5) S:X'="" SRRCS=X Q
- Q
- CVA S X=$P(SRA(205),"^",21),SRCVA=$S(X="Y":"Y",1:1) I SRCVA=1 Q
- N SROCC S SROCC=0 F S SROCC=$O(^SRF(SRTN,16,SROCC)) Q:'SROCC I $P(^SRF(SRTN,16,SROCC,0),"^",2)=12 S X=$P(^SRF(SRTN,16,SROCC,0),"^",8) S:X'="" SRCVA=X Q
- Q
- CPR S SRIP=$P(SRA(205),"^",26) I SRIP'="Y" Q
- N SROCC S SROCC=0 F S SROCC=$O(^SRF(SRTN,10,SROCC)) Q:'SROCC I $P(^SRF(SRTN,10,SROCC,0),"^",2)=16 S SRIP="I" Q
- I SRIP="Y" S SROCC=0 F S SROCC=$O(^SRF(SRTN,16,SROCC)) Q:'SROCC I $P(^SRF(SRTN,16,SROCC,0),"^",2)=16 S SRIP="P" Q
- Q
- ADD182(SRTN) ; SR*3*182 change
- N I,SRC,SRMP,SRN25,SRT
- S SRN25=$G(^SRF(SRTN,25)),SRMP=""
- S SRMP=$J($P(SRN25,"^"),3)_$J($P(SRN25,"^",2),3)_$J($P(SRN25,"^",3),3)_$J($P(SRN25,"^",6),1)_$J($P(SRN25,"^",7),1)_$J($P(SRN25,"^",8),1)
- S (I,SRC,SRT)=0 F S I=$O(^SRF(SRTN,1,I)) Q:'I I $D(^(I,0)) S SRT=SRT+1 I $P($G(^SRF(SRTN,1,I,1)),"^",5)="Y" S SRC=SRC+1
- S SRMP=SRMP_$J(SRT,3)_$J(SRC,3)
- Q SRMP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATCM1 10447 printed Feb 19, 2025@00:08:35 Page 2
- SROATCM1 ;BIR/MAM - STUFF TRANMISSION IN ^TMP ;09/28/2011
- +1 ;;3.0;Surgery;**38,71,79,90,88,93,95,111,125,135,134,142,153,160,174,175,176,177,182,184,200**;24 Jun 93;Build 9
- +2 KILL SRA
- FOR I=0,.2,52,200,201,202,205:1:208,207.1,209,202.1,200.1,"1.0",210,211,"VERD"
- SET SRA(I)=$GET(^SRF(SRTN,I))
- +3 SET DFN=$PIECE(SRA(0),"^")
- NEW I
- DO DEM^VADPT
- SET SRANAME=VADM(1)
- SET SEX=$PIECE(VADM(5),"^")
- SET Z=$PIECE(VADM(3),"^")
- SET SRSDATE=$PIECE(SRA(0),"^",9)
- SET Y=$EXTRACT(SRSDATE,1,7)
- SET AGE=$EXTRACT(Y,1,3)-$EXTRACT(Z,1,3)-($EXTRACT(Y,4,7)<$EXTRACT(Z,4,7))
- +4 ; remove hyphens from PID
- NEW SRPID
- SET SRPID=VA("PID")
- SET SRPID=$TRANSLATE(SRPID,"-","")
- +5 NEW SROBOT
- SET SROBOT=$PIECE($GET(^SRF(SRTN,"OP")),U,3)
- SET SHEMP="{"_$JUSTIFY(SRASITE,3)_$JUSTIFY(SRTN,7)_" 1 "_DT_$JUSTIFY(AGE,3)_$JUSTIFY(SEX,1)_$JUSTIFY(SRSDATE,12,4)_$JUSTIFY(SRPID,21)_$JUSTIFY($PIECE($GET(SRA(208)),"^",11),2)_$JUSTIFY(SROBOT,2)
- +6 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 2 "
- SET SRACNT=SRACNT+1
- +7 SET SRHD=$PIECE(SRA(206),"^")
- +8 IF SRHD["C"
- SET SRH="C"
- SET SRHD=$EXTRACT(SRHD,1,$LENGTH(SRHD)-1)
- +9 IF '$TEST
- SET SRH=" "
- +10 SET SRWD=$PIECE(SRA(206),"^",2)
- +11 IF SRWD["K"
- SET SRW="K"
- SET SRWD=$EXTRACT(SRWD,1,$LENGTH(SRWD)-1)
- +12 IF '$TEST
- SET SRW=" "
- +13 SET SHEMP=SHEMP_$JUSTIFY(SRHD,3)_SRH_$JUSTIFY(SRWD,3)_SRW_$JUSTIFY($PIECE(SRA(200),"^",2),2)_$JUSTIFY($PIECE(SRA(200),"^",11),2)_$JUSTIFY($PIECE(SRA(206),"^",5),3)_$JUSTIFY($PIECE(SRA(206),"^",6),2)_$JUSTIFY($PIECE(SRA(206),"^",7),2)
- +14 SET SRCT=$PIECE($GET(^SRF(SRTN,201)),"^",4)
- if SRCT["NS"
- SET SRCT=""
- +15 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(200.1),"^",5),2)_$JUSTIFY(SRCT,4)_$JUSTIFY($PIECE(SRA(206),"^",10),2)_$JUSTIFY($PIECE(SRA(206),"^",11),2)_$JUSTIFY($PIECE(SRA(200),"^",8),2)_$JUSTIFY($PIECE(SRA(200.1),"^",2),2)_$JUSTIFY(...
- ... $PIECE(SRA(206),"^",14),2)_$JUSTIFY(" ",2)
- +16 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(206),"^",16),2)_$JUSTIFY($PIECE(SRA(206),"^",17),2)_$JUSTIFY($PIECE(SRA(206),"^",18),3)_...
- ... $JUSTIFY($PIECE(SRA(206),"^",19),3)_$JUSTIFY($PIECE(SRA(206),"^",20),2)_$JUSTIFY($PIECE(SRA(206),"^",21),2)_$JUSTIFY($PIECE(SRA(206),"^",22),2)_$JUSTIFY($PIECE(SRA(206),"^",23),2)
- +17 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP_$JUSTIFY($PIECE(SRA(208),"^",19),2)_$JUSTIFY($PIECE(SRA(205),"^",8),2)_$JUSTIFY($PIECE(SRA(205),"^",6),2)_$JUSTIFY($PIECE(SRA(200),"^",59),1)_$JUSTIFY($PIECE(SRA(207),"^",29),2)_$JUSTIFY(...
- ... $PIECE(SRA(0),"^",26),1)
- +18 ;
- +19 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 3 "
- SET SRACNT=SRACNT+1
- +20 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(206),"^",24),2)_$JUSTIFY($PIECE(SRA(206),"^",25),3)_$JUSTIFY($PIECE(SRA(206),"^",26),3)_$JUSTIFY($PIECE(SRA(206),"^",27),3)
- +21 ; Left Main (node 3 pos 26-28), LAD (node 3 pos 29-31), Right Coronary (node 3 pos 32-34) & Circumflex Stenosis (node 3 pos 35-37)
- +22 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(206),"^",28),3)_$JUSTIFY($PIECE($GET(SRA(206)),"^",33),3)_$JUSTIFY($PIECE($GET(SRA(206)),"^",34),3)_$JUSTIFY($PIECE($GET(SRA(206)),"^",35),3)
- +23 ; LV Cont Grade (node 3 pos 39-40) & Mitral Regurgitation(node 3 pos 41-42)
- +24 NEW SROLV
- SET SROLV=$PIECE(SRA(206),"^",30)
- +25 SET SHEMP=SHEMP_$JUSTIFY($SELECT(SROLV="IIIa":"3A",SROLV="IIIb":"3B",1:SROLV),3)_$JUSTIFY($PIECE($GET(SRA(206)),"^",9),2)
- +26 ; Estimate of Mortality and ASA Class are changed to not transmit "NS"
- +27 SET SREMDATE=$PIECE($GET(SRA(206)),"^",32)
- +28 SET SREMO=$PIECE($GET(^SRF(SRTN,206)),"^",31)
- if SREMO["NS"
- SET SREMDATE=""
- +29 ; Estimate of Mortality (node 3 pos 43-45) & date (node 3 pos 46-57)
- +30 SET SHEMP=SHEMP_$JUSTIFY(SREMO,3)
- +31 SET SHEMP=SHEMP_$SELECT(SREMDATE="":$JUSTIFY(SREMDATE,12),1:$JUSTIFY(SREMDATE,12,4))
- +32 SET X=""
- SET Y=$PIECE($GET(^SRF(SRTN,1.1)),"^",3)
- if Y
- SET X=$PIECE($PIECE($GET(^SRO(132.8,Y,0)),"^"),"-")
- SET X=$EXTRACT(X)
- if X["N"
- SET X=""
- +33 SET SHEMP=SHEMP_$JUSTIFY(X,1)
- +34 ; Cardiac Est. of Surg. Priority(node 3 pos 59) & date(node 3 pos 60-71)
- +35 SET SHEMP=SHEMP_$JUSTIFY($PIECE($GET(SRA(208)),"^",12),1)
- +36 NEW SREMSPDT
- SET SREMSPDT=$PIECE($GET(SRA(208)),"^",13)
- +37 SET SHEMP=SHEMP_$SELECT(SREMSPDT="":$JUSTIFY(SREMSPDT,12),1:$JUSTIFY(SREMSPDT,12,4))_$JUSTIFY($PIECE(SRA("1.0"),"^",8),2)_$JUSTIFY($PIECE(SRA(210),"^",14),2)
- +38 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 4 "
- SET SRACNT=SRACNT+1
- +39 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(207),"^"),2)_$JUSTIFY($PIECE(SRA(207),"^",2),2)_$JUSTIFY($PIECE(SRA(207),"^",3),2)_$JUSTIFY($PIECE(SRA(207),"^",4),2)_$JUSTIFY($PIECE(SRA(207),"^",5),2)_$JUSTIFY(" ",2)_$JUSTIFY($PIECE(SRA(207),"^",7),2)
- +40 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(207),"^",8),2)_$JUSTIFY($PIECE(SRA(207),"^",9),2)_$JUSTIFY($PIECE(SRA(207),"^",10),2)_$JUSTIFY($PIECE(SRA(207),"^",12),2)_$JUSTIFY($PIECE(SRA(207),"^",13),2)_$JUSTIFY(...
- ... $PIECE(SRA(207),"^",14),2)_$JUSTIFY($PIECE(SRA(207),"^",15),2)
- +41 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(207),"^",16),2)_$JUSTIFY($PIECE(SRA(207),"^",17),2)_$JUSTIFY($PIECE(SRA(207),"^",18),2)_" "
- +42 SET SRDEATH=$PIECE($GET(SRA(208)),"^")
- SET SRDDATE=$EXTRACT($PIECE($GET(^DPT(DFN,.35)),"^"),1,12)
- IF SRDDATE'=""
- SET SRDDATE=$$LJ^XLFSTR(SRDDATE,12,0)
- +43 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(205),"^",41),2)_$JUSTIFY(SRDDATE,12)
- +44 NEW SRDIS
- SET SRDIS=$PIECE($GET(^SRF(SRTN,.4)),"^",6)
- if SRDIS
- SET SRDIS=$PIECE($GET(^SRO(131.6,SRDIS,0)),"^",2)
- +45 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(207),"^",20),1)_$JUSTIFY($PIECE(SRA(207),"^",28),2)_$JUSTIFY($PIECE(SRA(200.1),"^",8),1)_$JUSTIFY(SRDIS,3)
- +46 SET SRA(200.1)=$GET(^SRF(SRTN,200.1))
- SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(200.1),U,15),1)_$JUSTIFY($PIECE(SRA(210),"^",5),2)_$JUSTIFY($PIECE(SRA(210),"^",6),2)_$JUSTIFY($PIECE(SRA(210),"^",8),2)
- +47 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 5 "
- SET SRACNT=SRACNT+1
- +48 NEW SROR
- SET SROR=""
- SET Y=$PIECE(^SRF(SRTN,0),"^",2)
- SET C=$PIECE(^DD(130,.02,0),"^",2)
- IF Y'=""
- DO Y^DIQ
- SET SROR=Y
- +49 SET SHEMP=SHEMP_$JUSTIFY($EXTRACT(SROR,1,30),30)
- FOR I=1:1:6
- SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(52),"^",I),2)
- +50 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(200),"^",55),2)
- FOR I=9:1:14
- SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(200.1),"^",I),2)
- +51 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(210),"^",9),2)_$JUSTIFY($PIECE(SRA(210),"^",12),2)
- +52 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 6 "
- SET SRACNT=SRACNT+1
- +53 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(205),"^",27),2)_$JUSTIFY($PIECE(SRA(208),"^",3),2)_$JUSTIFY($PIECE(SRA(205),"^",17),2)_$JUSTIFY($PIECE(SRA(208),"^",4),2)_$JUSTIFY($PIECE(SRA(208),"^",5),2)_$JUSTIFY($PIECE(SRA(205),"^",28),2)_...
- ... $JUSTIFY($PIECE(SRA(208),"^",6),2)
- +54 NEW SRRCS
- DO RCSP
- SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(205),"^",13),2)_$JUSTIFY(SRRCS,2)_$JUSTIFY($PIECE(SRA(205),"^",22),2)
- +55 NEW SRCVA
- DO CVA
- SET SHEMP=SHEMP_$JUSTIFY(SRCVA,2)
- +56 NEW SRIP
- DO CPR
- SET SHEMP=SHEMP_$JUSTIFY(SRIP,2)
- +57 ;
- +58 ;Ethnicity contained in VADM(11)
- +59 NEW SROETCD,SROPTF
- SET SROETCD=""
- SET SROPTF=""
- +60 ;Ethnicity code
- SET SROETCD=$PIECE($GET(VADM(11,1)),U,1)
- +61 ;PTF Ethnicity code
- SET SROPTF=$$PTR2CODE^DGUTL4(SROETCD,2,4)
- +62 ;Ethnicity
- SET SHEMP=SHEMP_$JUSTIFY($GET(SROPTF),1)
- +63 ;
- +64 ;Multiple races contained in VADM(12)
- +65 NEW SRORAC,SRORCD,SRORCE
- SET SRORCE=0
- SET SRORAC=""
- SET SRORACE=""
- SET SRORCD=""
- +66 FOR
- SET SRORCE=$ORDER(VADM(12,SRORCE))
- if SRORCE=""
- QUIT
- Begin DoDot:1
- +67 ;Race code
- SET SRORAC=$PIECE($GET(VADM(12,SRORCE)),U,1)
- +68 ;PTF race code
- SET SRORCD=$$PTR2CODE^DGUTL4(SRORAC,1,4)
- +69 SET SRORACE=SRORACE_$JUSTIFY(SRORCD,1)
- End DoDot:1
- +70 ;Eth, race added
- SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP_SRORACE
- +71 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 7 "
- SET SRACNT=SRACNT+1
- +72 SET SHEMP=SHEMP_$TRANSLATE(SRANAME,","," ")
- +73 IF $PIECE($GET(^SRF(SRTN,"RA")),"^",3)=1
- SET SHEMP=SHEMP_$JUSTIFY("***RE-TRANSMISSION",38)
- +74 ; zip code, employ status, hemoglobin, hemo date, serum albumin, albumin date, creatitine date, total ischemic time, min invasive, total cpb time, total pre,post ICU & step down unit LOS,
- +75 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 8 "
- SET SRACNT=SRACNT+1
- +76 KILL VADM
- DO ADD^VADPT
- SET X=$SELECT($PIECE(VAPA(11),"^",2)'="":$PIECE(VAPA(11),"^",2),1:VAPA(6))
- +77 SET SHEMP=SHEMP_$JUSTIFY(X,10)_$JUSTIFY($PIECE(SRA(208),"^",18),1)_$JUSTIFY($PIECE(SRA(201),"^",20),7)_$JUSTIFY($PIECE(SRA(202),"^",20),7)_$JUSTIFY($PIECE(SRA(201),"^",8),4)_$JUSTIFY(...
- ... $PIECE(SRA(202),"^",8),7)_$JUSTIFY($PIECE(SRA(202),"^",4),7)_$JUSTIFY($PIECE(SRA(206),"^",36),4)
- +78 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(207),"^",22),1)_$JUSTIFY($PIECE(SRA(206),"^",37),4)_$JUSTIFY($PIECE(SRA(207),"^",23),2)
- +79 ; cpt codes
- NODE9 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 9 "
- SET SRACNT=SRACNT+1
- +1 SET SRPMOD=""
- SET SR10SP=" "
- SET CPT=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
- Begin DoDot:1
- +2 IF CPT
- SET CPT=$PIECE($$CPT^ICPTCOD(CPT),"^",2)
- SET SRCASE=SRTN
- DO MOD^SROATM3
- SET SRPMOD=SRM
- +3 SET SHEMP=SHEMP_$JUSTIFY(CPT,5)
- SET SRPMOD=SRPMOD_SR10SP
- End DoDot:1
- +4 KILL CPT
- FOR I=1:1:10
- SET (CPT(I),SRMOD(I))=""
- +5 SET (OPS,CNT)=0
- FOR
- SET OPS=$ORDER(^SRO(136,SRTN,3,OPS))
- if 'OPS!(CNT=10)
- QUIT
- SET CNT=CNT+1
- SET X=$PIECE($GET(^SRO(136,SRTN,3,OPS,0)),"^")
- IF X
- SET CPT(CNT)=$PIECE($$CPT^ICPTCOD(X),"^",2)
- DO OTH^SROATM3
- +6 SET SHEMP=SHEMP_$JUSTIFY(CPT(1),5)_$JUSTIFY(CPT(2),5)_$JUSTIFY(CPT(3),5)_$JUSTIFY(CPT(4),5)_$JUSTIFY(CPT(5),5)_$JUSTIFY(CPT(6),5)_$JUSTIFY(CPT(7),5)_$JUSTIFY(CPT(8),5)_$JUSTIFY(CPT(9),5)_$JUSTIFY(CPT(10),5)
- +7 ; card cath date, admission date/time, hospital discharge date/time, anesthesia start & end date/times
- +8 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 10"
- SET SRACNT=SRACNT+1
- +9 IF $PIECE(SRA(207),"^",21)'=""
- Begin DoDot:1
- +10 IF $EXTRACT($PIECE(SRA(207),"^",21),8)="."
- QUIT
- +11 IF '$TEST
- SET $PIECE(SRA(207),"^",21)=$PIECE(SRA(207),"^",21)_"."
- End DoDot:1
- +12 SET $PIECE(SRA(207),"^",21)=$$LJ^XLFSTR($PIECE(SRA(207),"^",21),12,0)
- +13 SET SHEMP=SHEMP_$JUSTIFY($EXTRACT($PIECE(SRA(207),"^",21),1,12),12)
- +14 SET (SRDATE,SRI)=""
- FOR SRI=14,15
- SET SRDATE=$EXTRACT($PIECE($GET(SRA(208)),"^",SRI),1,12)
- SET SRDATE=$$LJ^XLFSTR(SRDATE,12,0)
- SET SHEMP=SHEMP_SRDATE
- +15 SET (SRDATE,SRI)=""
- FOR SRI=1,4
- SET SRDATE=$PIECE(SRA(.2),"^",SRI)
- SET SRDATE=$$LJ^XLFSTR(SRDATE,12,0)
- SET SHEMP=SHEMP_SRDATE
- +16 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 11"
- SET SRACNT=SRACNT+1
- +17 SET (SRDATE,SRI)=""
- FOR SRI=10,12,2,3
- SET SRDATE=$PIECE(SRA(.2),"^",SRI)
- SET SRDATE=$$LJ^XLFSTR(SRDATE,12,0)
- SET SHEMP=SHEMP_SRDATE
- +18 ; preop risk factors comments
- +19 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 12"
- SET SRACNT=SRACNT+1
- SET SHEMP=SHEMP_$TRANSLATE($EXTRACT($GET(^SRF(SRTN,206.1)),1,65),",","^")
- +20 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 13"
- SET SRACNT=SRACNT+1
- SET SHEMP=SHEMP_$TRANSLATE($EXTRACT($GET(^SRF(SRTN,206.1)),66,130),",","^")
- +21 ; resource data comments
- +22 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 14"
- SET SRACNT=SRACNT+1
- SET SHEMP=SHEMP_$TRANSLATE($EXTRACT($GET(^SRF(SRTN,206.2)),1,65),",","^")
- +23 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 15"
- SET SRACNT=SRACNT+1
- SET SHEMP=SHEMP_$TRANSLATE($EXTRACT($GET(^SRF(SRTN,206.2)),66,130),",","^")
- +24 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SRACNT=SRACNT+1
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 16"_$EXTRACT(SRPMOD,1,10)
- FOR I=1:1:5
- SET SHEMP=SHEMP_$EXTRACT(SRMOD(I)_SR10SP,1,10)
- +25 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SRACNT=SRACNT+1
- SET SHEMP=$EXTRACT(SHEMP,1,11)_" 17"
- FOR I=6:1:10
- SET SHEMP=SHEMP_$EXTRACT(SRMOD(I)_SR10SP,1,10)
- +26 SET X=$$SITE^SROUTL0(SRTN)
- SET SRDIV=$SELECT(X:$PIECE(^SRO(133,X,0),"^"),1:"")
- SET SRDIV=$SELECT(SRDIV:$$GET1^DIQ(4,SRDIV,99),1:SRASITE)
- SET SHEMP=SHEMP_$JUSTIFY(SRDIV,6)
- +27 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SRACNT=SRACNT+1
- +28 QUIT
- RCSP SET SRRCS=0
- SET X=$PIECE(SRA(208),"^",7)
- IF X="N"
- QUIT
- +1 NEW SROCC
- SET SROCC=0
- FOR
- SET SROCC=$ORDER(^SRF(SRTN,16,SROCC))
- if 'SROCC
- QUIT
- IF $PIECE(^SRF(SRTN,16,SROCC,0),"^",2)=27
- SET X=$PIECE(^SRF(SRTN,16,SROCC,0),"^",5)
- if X'=""
- SET SRRCS=X
- QUIT
- +2 QUIT
- CVA SET X=$PIECE(SRA(205),"^",21)
- SET SRCVA=$SELECT(X="Y":"Y",1:1)
- IF SRCVA=1
- QUIT
- +1 NEW SROCC
- SET SROCC=0
- FOR
- SET SROCC=$ORDER(^SRF(SRTN,16,SROCC))
- if 'SROCC
- QUIT
- IF $PIECE(^SRF(SRTN,16,SROCC,0),"^",2)=12
- SET X=$PIECE(^SRF(SRTN,16,SROCC,0),"^",8)
- if X'=""
- SET SRCVA=X
- QUIT
- +2 QUIT
- CPR SET SRIP=$PIECE(SRA(205),"^",26)
- IF SRIP'="Y"
- QUIT
- +1 NEW SROCC
- SET SROCC=0
- FOR
- SET SROCC=$ORDER(^SRF(SRTN,10,SROCC))
- if 'SROCC
- QUIT
- IF $PIECE(^SRF(SRTN,10,SROCC,0),"^",2)=16
- SET SRIP="I"
- QUIT
- +2 IF SRIP="Y"
- SET SROCC=0
- FOR
- SET SROCC=$ORDER(^SRF(SRTN,16,SROCC))
- if 'SROCC
- QUIT
- IF $PIECE(^SRF(SRTN,16,SROCC,0),"^",2)=16
- SET SRIP="P"
- QUIT
- +3 QUIT
- ADD182(SRTN) ; SR*3*182 change
- +1 NEW I,SRC,SRMP,SRN25,SRT
- +2 SET SRN25=$GET(^SRF(SRTN,25))
- SET SRMP=""
- +3 SET SRMP=$JUSTIFY($PIECE(SRN25,"^"),3)_$JUSTIFY($PIECE(SRN25,"^",2),3)_$JUSTIFY($PIECE(SRN25,"^",3),3)_$JUSTIFY($PIECE(SRN25,"^",6),1)_$JUSTIFY($PIECE(SRN25,"^",7),1)_$JUSTIFY($PIECE(SRN25,"^",8),1)
- +4 SET (I,SRC,SRT)=0
- FOR
- SET I=$ORDER(^SRF(SRTN,1,I))
- if 'I
- QUIT
- IF $DATA(^(I,0))
- SET SRT=SRT+1
- IF $PIECE($GET(^SRF(SRTN,1,I,1)),"^",5)="Y"
- SET SRC=SRC+1
- +5 SET SRMP=SRMP_$JUSTIFY(SRT,3)_$JUSTIFY(SRC,3)
- +6 QUIT SRMP