SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ;05/11/10
;;3.0;Surgery;**125,135,153,164,166,174,177,182,184**;24 Jun 93;Build 35
N SRDISP,NYUK S SRDISP="",NYUK=$P(SRRES(1),U,2),SRA(209.1)=$G(^SRF(SRTN,209.1)),SRA(207.1)=$G(^SRF(SRTN,207.1)),SRA(205)=$G(^SRF(SRTN,205)),SRA(208)=$G(^SRF(SRTN,208))
I NYUK'="" D
.S SRDISP=$S(NYUK="BOARDING HOUSE":16,NYUK="COMMUNITY HOSPITAL":6,NYUK="COMMUNITY NURSING HOME":8,NYUK="FOSTER HOME":14,NYUK="HALFWAY HOUSE":15,NYUK="HOME-BASED PRIMARY CARE (HBPC)":20,1:NYUK)
.Q:SRDISP'=NYUK S SRDISP=$S(NYUK="HOSPICE CARE":22,NYUK="MILITARY HOSPITAL":3,NYUK="NURSE CARE CONTD ANOTHER COMM ":10,NYUK="NURSING CARE CONT AT SAME NURS":9,NYUK="OTHER FEDERAL HOSPITAL":4,1:NYUK)
.Q:SRDISP'=NYUK S SRDISP=$S(NYUK="OTHER GOVERNMENT HOSPITAL":5,NYUK="OTHER PLACEMENT/UNKNOWN (NOT S":19,NYUK="PENAL INSTITUTION":17,NYUK="REFER MEDICARE HOME HEALTH CAR":25,NYUK="REFER OTHER AGENCY-PD HOME HEA":26,1:NYUK)
.Q:SRDISP'=NYUK S SRDISP=$S(NYUK="REFER VA-PD HOME/COMMUNITY HEA":24,NYUK="RESIDENTIAL HOTEL/RESIDENT (IE":18,NYUK="RESPITE CARE":23,NYUK="RETURN TO COMMUNITY-INDEPENDEN":1,NYUK="SPINAL CORD INJURY-VACO APPROV":21,1:NYUK)
.Q:SRDISP'=NYUK S SRDISP=$S(NYUK="STATE HOME":11,NYUK="STATE HOME":13,NYUK="VA DOMICILLARY":12,NYUK="VA MEDICAL CENTER":2,NYUK="VA NURSING HOME CARE UNIT (NHC":7,1:"")
;
LN26 S SHEMP=$E(SHEMP,1,11)_" 26"_$J(SRDISP,2)_$J($P(SRA(200),"^",56),2)_$J($P(SRA(206),"^",15),2)_$J("",2)_$J($P(SRA(207),"^",27),2)_$J($P(SRA(209),"^"),2)_$J($P(SRA(209),"^",2),2)
S SHEMP=SHEMP_$J($P(SRA(209),"^",3),2)_$J($P(SRA(209),"^",4),2)_$J($P(SRA(209),"^",5),2)_$J($P(SRA(209),"^",6),3)_$J($P(SRA(209),"^",7),3)_$J($P(SRA(209),"^",8),3)_$J($P(SRA(209),"^",9),2)_$J($P(SRA(209),"^",10),2)
S X=$P(SRA(206),"^",42),Y="" F I=1:1:6 S Y=Y_$P(X,",",I)
S SHEMP=SHEMP_$J($P(SRA(209),"^",11),2)_$J("",5)
S X=$P(SRA(209),"^",12) S:X="" X="N" S SHEMP=SHEMP_$J(X,2)_$J(Y,6)
S X=$P(SRA(205),"^",43) S:X="" X="N" S SHEMP=SHEMP_$J(X,2)
S X=$P(SRA(205),"^",44) S:X="" X="N" S SHEMP=SHEMP_$J(X,2)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN27 ;Line #27 - Other Cardiac Procedures
S SHEMP=$E(SHEMP,1,11)_" 27"_$TR($E($G(SRA(209.1)),1,65),",","^")
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN28 ;Lines 28 - New fields added in 2006 update
S SHEMP=$E(SHEMP,1,11)_" 28"_$J($P(SRA(209),"^",13),2)_$J($P(SRA(209),"^",14),2)_$J($P(SRA(207.1),"^",2),2)_$J($P(SRA(201),"^",28),6)_$J($P(SRA(202.1),"^"),7)
S SHEMP=SHEMP_$J($P(SRA(201),"^",29),5)_$J($P(SRA(202.1),"^",2),7)
I $D(SRRES(2)) F I=8,9 S SHEMP=SHEMP_$J($P(SRRES(2),"^",I),8)
S SRA(210)=$G(^SRF(SRTN,210)),SRA(200.1)=$G(^SRF(SRTN,200.1))
S SHEMP=SHEMP_$S('$D(SRRES(2)):" ",1:"")_$J($P(SRA(210),"^"),1)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN29 ;
N II,OT S SRA("VER1")=$G(^SRF(SRTN,"VER1"))
S II=0,OT="" F S II=$O(^SRF(SRTN,63,"B",II)) Q:'II S OT=OT_II
S SHEMP=$E(SHEMP,1,11)_" 29"_$J(OT,7)_$J($P(SRA("VER1"),"^",2),10)_$J($P(SRA("VER1"),"^",3),2)_$J($P(SRA("VER1"),"^",4),2)_$J($P(SRA("VER1"),"^",5),2)
S SHEMP=SHEMP_$J($P(SRA("VER1"),"^",6),2)_$J($P(SRA("VER1"),"^",7),1)_$J($P(SRA("VER1"),"^",8),1)_$J($P(SRA("VER1"),"^",9),1)_$J($E($P(SRA("VER1"),"^",19),1,12),12)
S SHEMP=SHEMP_$J($P(SRA("VER1"),"^",10),1)_$J($E($P(SRA("VER1"),"^",21),1,12),12)_$J($P(SRA("VER1"),"^",22),1)_$J($P(SRA("VER1"),"^",12),1)_$J($P(SRA("VER1"),"^",24),1)
S SHEMP=SHEMP_$J($P(SRA("VER1"),"^",14),1)_$J($P(SRA("VER1"),"^",15),1)_$J($P(SRA("VER1"),"^",16),1)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN30 ;
N SRNM11,SRNM13,SRNM23,SRNM25 S (SRNM11,SRNM13,SRNM23,SRNM25)=""
F II=11,23,13,25 I $P(SRA("VER1"),"^",II) S @("SRNM"_II)=$P($G(^VA(200,$P(SRA("VER1"),"^",II),0)),"^")
S SHEMP=$E(SHEMP,1,11)_" 30"_$J($E(SRNM11,1,30),30)_$J($E(SRNM23,1,30),30)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN31 ;
S SHEMP=$E(SHEMP,1,11)_" 31"_$J($E(SRNM13,1,30),30)_$J($E(SRNM25,1,30),30)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN32 ;
S II=0,(SRC,OT)="" F S SRC=$O(^SRF(SRTN,57,"B",SRC)) Q:SRC=""!(II=7) S OT=OT_$J($E(SRC,1,10),10),II=II+1
S SHEMP=$E(SHEMP,1,11)_" 32"_$J($E(OT,1,60),60)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN33 ;
S OT1="" F I=1:1:17,19:1:28 S OT1=OT1_$J($P(SRA(211),U,I),2)
S SHEMP=$E(SHEMP,1,11)_" 33"_$J($E(OT,61,70),10)_OT1
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN34 ;
S (SRC,OT)="" F S SRC=$O(^SRF(SRTN,64,"B",SRC)) Q:'SRC S OT=OT_$J(SRC,1)
S SHEMP=$E(SHEMP,1,11)_" 34"_$J(OT,6)_$J($P(SRA(211),U,30),2)_$J($P(SRA(211),U,31),5)_$J($P(SRA(211),U,32),5)_$J($P(SRA(211),U,35),5)
S OT="",II=0 F II="34;4","39;4","33;3","36;3","40;3","37;2","38;2","41;2","42;2","43;2" S OT=OT_$J($P(SRA(211),U,+II),$P(II,";",2))
S SHEMP=SHEMP_OT_$J($P(SRA("VERD"),U,6),4)_$J($P(SRA("VERD"),U,7),5)_$J($P(SRA("VERD"),U,8),4)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
LN35 ;
S OT="" F II=2:1:4,7,10,11 S OT=OT_$J($P(SRA(210),U,II),2)
S SHEMP=$E(SHEMP,1,11)_" 35"_OT
S OT="" F II=44:1:53 S OT=OT_$J($P(SRA(211),U,II),2)
S SHEMP=SHEMP_OT_$J($E($P(SRA(211),U,54),1,12),12)_$J($E($P(SRA(211),U,55),1,12),12)_$J($P(SRA(211),U,56),3)_$J($P(SRA(211),U,57),3)
S ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROATCM3 5318 printed Apr 09, 2024@21:42:50 Page 2
SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ;05/11/10
+1 ;;3.0;Surgery;**125,135,153,164,166,174,177,182,184**;24 Jun 93;Build 35
+2 NEW SRDISP,NYUK
SET SRDISP=""
SET NYUK=$PIECE(SRRES(1),U,2)
SET SRA(209.1)=$GET(^SRF(SRTN,209.1))
SET SRA(207.1)=$GET(^SRF(SRTN,207.1))
SET SRA(205)=$GET(^SRF(SRTN,205))
SET SRA(208)=$GET(^SRF(SRTN,208))
+3 IF NYUK'=""
Begin DoDot:1
+4 SET SRDISP=$SELECT(NYUK="BOARDING HOUSE":16,NYUK="COMMUNITY HOSPITAL":6,NYUK="COMMUNITY NURSING HOME":8,NYUK="FOSTER HOME":14,NYUK="HALFWAY HOUSE":15,NYUK="HOME-BASED PRIMARY CARE (HBPC)":20,1:NYUK)
+5 if SRDISP'=NYUK
QUIT
SET SRDISP=$SELECT(NYUK="HOSPICE CARE":22,NYUK="MILITARY HOSPITAL":3,NYUK="NURSE CARE CONTD ANOTHER COMM ":10,NYUK="NURSING CARE CONT AT SAME NURS":9,NYUK="OTHER FEDERAL HOSPITAL":4,1:NYUK)
+6 if SRDISP'=NYUK
QUIT
SET SRDISP=$SELECT(NYUK="OTHER GOVERNMENT HOSPITAL":5,NYUK="OTHER PLACEMENT/UNKNOWN (NOT S":19,NYUK="PENAL INSTITUTION":17,NYUK="REFER MEDICARE HOME HEALTH CAR":25,NYUK="REFER OTHER AGENCY-PD HOME HEA":26,1:NYUK)
+7 if SRDISP'=NYUK
QUIT
SET SRDISP=$SELECT(NYUK="REFER VA-PD HOME/COMMUNITY HEA":24,NYUK="RESIDENTIAL HOTEL/RESIDENT (IE":18,NYUK="RESPITE CARE":23,NYUK="RETURN TO COMMUNITY-INDEPENDEN":1,NYUK="SPINAL CORD INJURY-VACO APPROV":21,1:NYUK)
+8 if SRDISP'=NYUK
QUIT
SET SRDISP=$SELECT(NYUK="STATE HOME":11,NYUK="STATE HOME":13,NYUK="VA DOMICILLARY":12,NYUK="VA MEDICAL CENTER":2,NYUK="VA NURSING HOME CARE UNIT (NHC":7,1:"")
End DoDot:1
+9 ;
LN26 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 26"_$JUSTIFY(SRDISP,2)_$JUSTIFY($PIECE(SRA(200),"^",56),2)_$JUSTIFY($PIECE(SRA(206),"^",15),2)_$JUSTIFY("",2)_$JUSTIFY($PIECE(SRA(207),"^",27),2)_$JUSTIFY($PIECE(SRA(209),"^"),2)_$JUSTIFY($PIECE(SRA(209),"^",2),
2)
+1 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(209),"^",3),2)_$JUSTIFY($PIECE(SRA(209),"^",4),2)_$JUSTIFY($PIECE(SRA(209),"^",5),2)_$JUSTIFY(...
... $PIECE(SRA(209),"^",6),3)_$JUSTIFY($PIECE(SRA(209),"^",7),3)_$JUSTIFY($PIECE(SRA(209),"^",8),3)_$JUSTIFY($PIECE(SRA(209),"^",9),2)_$JUSTIFY($PIECE(SRA(209),"^",10),2)
+2 SET X=$PIECE(SRA(206),"^",42)
SET Y=""
FOR I=1:1:6
SET Y=Y_$PIECE(X,",",I)
+3 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(209),"^",11),2)_$JUSTIFY("",5)
+4 SET X=$PIECE(SRA(209),"^",12)
if X=""
SET X="N"
SET SHEMP=SHEMP_$JUSTIFY(X,2)_$JUSTIFY(Y,6)
+5 SET X=$PIECE(SRA(205),"^",43)
if X=""
SET X="N"
SET SHEMP=SHEMP_$JUSTIFY(X,2)
+6 SET X=$PIECE(SRA(205),"^",44)
if X=""
SET X="N"
SET SHEMP=SHEMP_$JUSTIFY(X,2)
+7 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN27 ;Line #27 - Other Cardiac Procedures
+1 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 27"_$TRANSLATE($EXTRACT($GET(SRA(209.1)),1,65),",","^")
+2 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN28 ;Lines 28 - New fields added in 2006 update
+1 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 28"_$JUSTIFY($PIECE(SRA(209),"^",13),2)_$JUSTIFY($PIECE(SRA(209),"^",14),2)_$JUSTIFY($PIECE(SRA(207.1),"^",2),2)_$JUSTIFY($PIECE(SRA(201),"^",28),6)_$JUSTIFY($PIECE(SRA(202.1),"^"),7)
+2 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(201),"^",29),5)_$JUSTIFY($PIECE(SRA(202.1),"^",2),7)
+3 IF $DATA(SRRES(2))
FOR I=8,9
SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRRES(2),"^",I),8)
+4 SET SRA(210)=$GET(^SRF(SRTN,210))
SET SRA(200.1)=$GET(^SRF(SRTN,200.1))
+5 SET SHEMP=SHEMP_$SELECT('$DATA(SRRES(2)):" ",1:"")_$JUSTIFY($PIECE(SRA(210),"^"),1)
+6 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN29 ;
+1 NEW II,OT
SET SRA("VER1")=$GET(^SRF(SRTN,"VER1"))
+2 SET II=0
SET OT=""
FOR
SET II=$ORDER(^SRF(SRTN,63,"B",II))
if 'II
QUIT
SET OT=OT_II
+3 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 29"_$JUSTIFY(OT,7)_$JUSTIFY($PIECE(SRA("VER1"),"^",2),10)_$JUSTIFY($PIECE(SRA("VER1"),"^",3),2)_$JUSTIFY($PIECE(SRA("VER1"),"^",4),2)_$JUSTIFY($PIECE(SRA("VER1"),"^",5),2)
+4 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA("VER1"),"^",6),2)_$JUSTIFY($PIECE(SRA("VER1"),"^",7),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",8),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",9),1)_$JUSTIFY($EXTRACT($PIECE(SRA("VER1"),"^",19),1,12),12)
+5 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA("VER1"),"^",10),1)_$JUSTIFY($EXTRACT($PIECE(SRA("VER1"),"^",21),1,12),12)_$JUSTIFY($PIECE(SRA("VER1"),"^",22),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",12),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",24),1)
+6 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA("VER1"),"^",14),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",15),1)_$JUSTIFY($PIECE(SRA("VER1"),"^",16),1)
+7 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN30 ;
+1 NEW SRNM11,SRNM13,SRNM23,SRNM25
SET (SRNM11,SRNM13,SRNM23,SRNM25)=""
+2 FOR II=11,23,13,25
IF $PIECE(SRA("VER1"),"^",II)
SET @("SRNM"_II)=$PIECE($GET(^VA(200,$PIECE(SRA("VER1"),"^",II),0)),"^")
+3 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 30"_$JUSTIFY($EXTRACT(SRNM11,1,30),30)_$JUSTIFY($EXTRACT(SRNM23,1,30),30)
+4 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN31 ;
+1 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 31"_$JUSTIFY($EXTRACT(SRNM13,1,30),30)_$JUSTIFY($EXTRACT(SRNM25,1,30),30)
+2 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN32 ;
+1 SET II=0
SET (SRC,OT)=""
FOR
SET SRC=$ORDER(^SRF(SRTN,57,"B",SRC))
if SRC=""!(II=7)
QUIT
SET OT=OT_$JUSTIFY($EXTRACT(SRC,1,10),10)
SET II=II+1
+2 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 32"_$JUSTIFY($EXTRACT(OT,1,60),60)
+3 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN33 ;
+1 SET OT1=""
FOR I=1:1:17,19:1:28
SET OT1=OT1_$JUSTIFY($PIECE(SRA(211),U,I),2)
+2 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 33"_$JUSTIFY($EXTRACT(OT,61,70),10)_OT1
+3 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN34 ;
+1 SET (SRC,OT)=""
FOR
SET SRC=$ORDER(^SRF(SRTN,64,"B",SRC))
if 'SRC
QUIT
SET OT=OT_$JUSTIFY(SRC,1)
+2 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 34"_$JUSTIFY(OT,6)_$JUSTIFY($PIECE(SRA(211),U,30),2)_$JUSTIFY($PIECE(SRA(211),U,31),5)_$JUSTIFY($PIECE(SRA(211),U,32),5)_$JUSTIFY($PIECE(SRA(211),U,35),5)
+3 SET OT=""
SET II=0
FOR II="34;4","39;4","33;3","36;3","40;3","37;2","38;2","41;2","42;2","43;2"
SET OT=OT_$JUSTIFY($PIECE(SRA(211),U,+II),$PIECE(II,";",2))
+4 SET SHEMP=SHEMP_OT_$JUSTIFY($PIECE(SRA("VERD"),U,6),4)_$JUSTIFY($PIECE(SRA("VERD"),U,7),5)_$JUSTIFY($PIECE(SRA("VERD"),U,8),4)
+5 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
LN35 ;
+1 SET OT=""
FOR II=2:1:4,7,10,11
SET OT=OT_$JUSTIFY($PIECE(SRA(210),U,II),2)
+2 SET SHEMP=$EXTRACT(SHEMP,1,11)_" 35"_OT
+3 SET OT=""
FOR II=44:1:53
SET OT=OT_$JUSTIFY($PIECE(SRA(211),U,II),2)
+4 SET SHEMP=SHEMP_OT_$JUSTIFY($EXTRACT($PIECE(SRA(211),U,54),1,12),12)_$JUSTIFY($EXTRACT($PIECE(SRA(211),U,55),1,12),12)_$JUSTIFY($PIECE(SRA(211),U,56),3)_$JUSTIFY($PIECE(SRA(211),U,57),3)
+5 SET ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
SET SRACNT=SRACNT+1
+6 QUIT
