- SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ;12/03/07
- ;;3.0; Surgery ;**125,135,153,164,166**;24 Jun 93;Build 6
- 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))
- 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(206),"^",13),2)_$J($P(SRA(206),"^",15),2)_$J($P(SRA(207),"^",6),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:5 S Y=Y_$P(X,",",I)
- S SHEMP=SHEMP_$J($P(SRA(209),"^",11),2)_$J(Y,5)
- S X=$P(SRA(209),"^",12) S:X="" X="N" S SHEMP=SHEMP_$J(X,2)
- ; CT Surgery Consult Date and cause for delay
- S SRDATE=$P(SRA(209),"^",15),SRDATE=$$LJ^XLFSTR(SRDATE,7,0),SHEMP=SHEMP_SRDATE
- S X=$P(SRA(209),"^",16),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 ^TMP("SRA",$J,SRAMNUM,SRACNT,0)=SHEMP,SRACNT=SRACNT+1
- Q
- SROATCM3 ;BIR/SJA - STUFF TRANMISSION IN ^TMP ;12/03/07
- +1 ;;3.0; Surgery ;**125,135,153,164,166**;24 Jun 93;Build 6
- +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))
- +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(206),"^",13),2)_$JUSTIFY($PIECE(SRA(206),"^",15),2)_$JUSTIFY($PIECE(SRA(207),"^",6),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:5
- SET Y=Y_$PIECE(X,",",I)
- +3 SET SHEMP=SHEMP_$JUSTIFY($PIECE(SRA(209),"^",11),2)_$JUSTIFY(Y,5)
- +4 SET X=$PIECE(SRA(209),"^",12)
- IF X=""
- SET X="N"
- SET SHEMP=SHEMP_$JUSTIFY(X,2)
- +5 ; CT Surgery Consult Date and cause for delay
- +6 SET SRDATE=$PIECE(SRA(209),"^",15)
- SET SRDATE=$$LJ^XLFSTR(SRDATE,7,0)
- SET SHEMP=SHEMP_SRDATE
- +7 SET X=$PIECE(SRA(209),"^",16)
- SET SHEMP=SHEMP_$JUSTIFY(X,2)
- +8 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 ^TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SHEMP
- SET SRACNT=SRACNT+1
- +3 QUIT
