source: FOIAVistA/tag/r/SURGERY-SR/SROATCM1.m@ 1641

Last change on this file since 1641 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1SROATCM1 ;BIR/MAM - STUFF TRANMISSION IN ^TMP ;05/10/07
2 ;;3.0; Surgery ;**38,71,79,90,88,93,95,111,125,135,134,142,153,160**;24 Jun 93;Build 7
3 K SRA F I=0,.2,200,201,202,205:1:208,207.1,209,202.1,200.1 S SRA(I)=$G(^SRF(SRTN,I))
4 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))
5 N SRPID S SRPID=VA("PID"),SRPID=$TR(SRPID,"-","") ; remove hyphens from PID
6 S SHEMP="~"_$J(SRASITE,3)_$J(SRTN,7)_" 1 "_DT_$J(AGE,3)_$J(SEX,1)_$J(SRSDATE,12,4)_SRPID
7 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 2 ",SRACNT=SRACNT+1
8 S SRHD=$P(SRA(206),"^")
9 I SRHD["C" S SRH="C",SRHD=$E(SRHD,1,$L(SRHD)-1)
10 E S SRH=" "
11 S SRWD=$P(SRA(206),"^",2)
12 I SRWD["K" S SRW="K",SRWD=$E(SRWD,1,$L(SRWD)-1)
13 E S SRW=" "
14 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)
15 S SRCT=$P($G(^SRF(SRTN,201)),"^",4) S:SRCT["NS" SRCT=""
16 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(" ",2)_$J($P(SRA(206),"^",14),2)_$J(" ",2)
17 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)
18 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 3 ",SRACNT=SRACNT+1
19 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)
20 ; 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)
21 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)
22 ; LV Cont Grade (node 3 pos 39-40) & Mitral Regurgitation(node 3 pos 41-42)
23 N SROLV S SROLV=$P(SRA(206),"^",30)
24 S SHEMP=SHEMP_$J($S(SROLV="IIIa":"3A",SROLV="IIIb":"3B",1:SROLV),3)_$J($P($G(SRA(206)),"^",9),2)
25 ; Estimate of Mortality and ASA Class are changed to not transmit "NS"
26 S SREMDATE=$P($G(SRA(206)),"^",32)
27 S SREMO=$P($G(^SRF(SRTN,206)),"^",31) S:SREMO["NS" SREMDATE=""
28 ; Estimate of Mortality (node 3 pos 43-45) & date (node 3 pos 46-57)
29 S SHEMP=SHEMP_$J(SREMO,3)
30 S SHEMP=SHEMP_$S(SREMDATE="":$J(SREMDATE,12),1:$J(SREMDATE,12,4))
31 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=""
32 S SHEMP=SHEMP_$J(X,1)
33 ; Cardiac Est. of Surg. Priority(node 3 pos 59) & date(node 3 pos 60-71)
34 S SHEMP=SHEMP_$J($P($G(SRA(208)),"^",12),1)
35 N SREMSPDT S SREMSPDT=$P($G(SRA(208)),"^",13)
36 S SHEMP=SHEMP_$S(SREMSPDT="":$J(SREMSPDT,12),1:$J(SREMSPDT,12,4))
37 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 4 ",SRACNT=SRACNT+1
38 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)
39 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)
40 S SHEMP=SHEMP_$J($P(SRA(207),"^",16),2)_$J($P(SRA(207),"^",17),2)_$J($P(SRA(207),"^",18),2)_" "
41 S SRDEATH=$P($G(SRA(208)),"^"),SRDDATE=$E($P($G(^DPT(DFN,.35)),"^"),1,12) I SRDDATE'="" S SRDDATE=$$LJ^XLFSTR(SRDDATE,12,0)
42 S SHEMP=SHEMP_$J(SRDEATH,2)_$J(SRDDATE,12)
43 S SHEMP=SHEMP_$P(SRA(207),"^",20)
44 ; transmit no data in node 5
45 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 5 ",SRACNT=SRACNT+1
46 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 6 ",SRACNT=SRACNT+1
47 S SHEMP=SHEMP_$J($P(SRA(208),"^",2),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)
48 N SRRCS D RCSP S SHEMP=SHEMP_$J($P(SRA(205),"^",13),2)_$J(SRRCS,2)_$J($P(SRA(205),"^",22),2)_$J($P(SRA(205),"^",21),2)
49 N SRIP D CPR S SHEMP=SHEMP_$J(SRIP,2)
50 ;
51 ;Ethnicity contained in VADM(11)
52 N SROETCD,SROPTF S SROETCD="",SROPTF=""
53 S SROETCD=$P($G(VADM(11,1)),U,1) ;Ethnicity code
54 S SROPTF=$$PTR2CODE^DGUTL4(SROETCD,2,4) ;PTF Ethnicity code
55 S SHEMP=SHEMP_$J($G(SROPTF),1) ;Ethnicity
56 ;
57 ;Multiple races contained in VADM(12)
58 N SRORAC,SRORCD,SRORCE S SRORCE=0,SRORAC="",SRORACE="",SRORCD=""
59 F S SRORCE=$O(VADM(12,SRORCE)) Q:SRORCE="" D
60 .S SRORAC=$P($G(VADM(12,SRORCE)),U,1) ;Race code
61 .S SRORCD=$$PTR2CODE^DGUTL4(SRORAC,1,4) ;PTF race code
62 .S SRORACE=SRORACE_$J(SRORCD,1)
63 ;
64 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP_SRORACE ;Eth, race added
65 ;
66 S SHEMP=$E(SHEMP,1,11)_" 7 ",SRACNT=SRACNT+1
67 S SHEMP=SHEMP_$TR(SRANAME,","," ")
68 I $P($G(^SRF(SRTN,"RA")),"^",3)=1 S SHEMP=SHEMP_$J("***RE-TRANSMISSION",38)
69 ; 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,
70 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 8 ",SRACNT=SRACNT+1
71 K VADM D ADD^VADPT S X=$S($P(VAPA(11),"^",2)'="":$P(VAPA(11),"^",2),1:VAPA(6))
72 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)
73 S SHEMP=SHEMP_$J($P(SRA(207),"^",22),1)_$J($P(SRA(206),"^",37),4)_$J($P(SRA(207),"^",23),2)
74 ; cpt codes
75NODE9 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 9 ",SRACNT=SRACNT+1
76 S SRPMOD="",SR10SP=" ",CPT=$P($G(^SRO(136,SRTN,0)),"^",2) D
77 .I CPT S CPT=$P($$CPT^ICPTCOD(CPT),"^",2),SRCASE=SRTN D MOD^SROATM3 S SRPMOD=SRM
78 .S SHEMP=SHEMP_$J(CPT,5),SRPMOD=SRPMOD_SR10SP
79 K CPT F I=1:1:10 S (CPT(I),SRMOD(I))=""
80 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
81 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)
82 ; card cath date, admission date/time, hospital discharge date/time, anesthesia start & end date/times
83 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 10",SRACNT=SRACNT+1
84 I $P(SRA(207),"^",21)'="" D
85 .I $E($P(SRA(207),"^",21),8)="." Q
86 .E S $P(SRA(207),"^",21)=$P(SRA(207),"^",21)_"."
87 S $P(SRA(207),"^",21)=$$LJ^XLFSTR($P(SRA(207),"^",21),12,0)
88 S SHEMP=SHEMP_$J($E($P(SRA(207),"^",21),1,12),12)
89 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
90 S (SRDATE,SRI)="" F SRI=1,4 S SRDATE=$P(SRA(.2),"^",SRI) S SRDATE=$$LJ^XLFSTR(SRDATE,12,0) S SHEMP=SHEMP_SRDATE
91 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SHEMP=$E(SHEMP,1,11)_" 11",SRACNT=SRACNT+1
92 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
93 ; preop risk factors comments
94 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),",","^")
95 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),",","^")
96 ; resource data comments
97 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),",","^")
98 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),",","^")
99 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)
100 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)
101 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)
102 S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
103 Q
104RCSP S SRRCS=0,X=$P(SRA(208),"^",7) I X="N" Q
105 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
106 Q
107CPR S SRIP=$P(SRA(205),"^",26) I SRIP'="Y" Q
108 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
109 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
110 Q
Note: See TracBrowser for help on using the repository browser.