SRTPTM2 ;BIR/SJA - TRANSPLANT TRANSMISSION ;03/08/11
;;3.0;Surgery;**167,175**;24 Jun 93;Build 6
;K SRA,VALM S SRA(0)=^SRT(SRTPP,0),DFN=$P(SRA(0),"^"),SRA(.11)=$G(^SRT(SRTPP,.11)) D ADD^VADPT
D ADD^VADPT
LN14 ;Other Cardiomyopathy
S SRSHEMP=$E(SRSHEMP,1,11)_" 14",SRACNT=SRACNT+1
S TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRSHEMP_$E($P(SRA(.11),"^",15),1,60)
LN15 S SRSHEMP=$E(SRSHEMP,1,11)_" 15",SRACNT=SRACNT+1
S TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRSHEMP_$J($E(SRANAME,1,40),40)_$J(VAPA(8),20)
LN16 S SRSHEMP=$E(SRSHEMP,1,11)_" 16",SRACNT=SRACNT+1
S SRSHEMP=SRSHEMP_$J(VAPA(1),35)_$J(VAPA(2),30),TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRSHEMP
LN17 S SRSHEMP=$E(SRSHEMP,1,11)_" 17",SRACNT=SRACNT+1
S SRSHEMP=SRSHEMP_$J(VAPA(3),30)_$J(VAPA(4),15)
K DA,DIC,DIQ,DR,SRY S X=$P(VAPA(5),"^") I X S DIC=5,DA=X,DR=1,DIQ="SRY",DIQ(0)="E" D EN^DIQ1 S X=SRY(5,$P(VAPA(5),"^"),1,"E")
S SRSHEMP=SRSHEMP_$J(X,5)
S X=$S($P(VAPA(11),"^",2)'="":$P(VAPA(11),"^",2),1:VAPA(6)),TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRSHEMP_$J(X,10)
LN18 S SRSHEMP=$E(SRSHEMP,1,11)_" 18",SRACNT=SRACNT+1
S SRSHEMP=SRSHEMP_$J($P(SRA(0),"^",18),19)_$J($P(SRA(1),"^",13),19)
S TMP("SRA",$J,SRAMNUM,SRACNT,0)=SRSHEMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPTM2 1186 printed Dec 13, 2024@02:48:56 Page 2
SRTPTM2 ;BIR/SJA - TRANSPLANT TRANSMISSION ;03/08/11
+1 ;;3.0;Surgery;**167,175**;24 Jun 93;Build 6
+2 ;K SRA,VALM S SRA(0)=^SRT(SRTPP,0),DFN=$P(SRA(0),"^"),SRA(.11)=$G(^SRT(SRTPP,.11)) D ADD^VADPT
+3 DO ADD^VADPT
LN14 ;Other Cardiomyopathy
+1 SET SRSHEMP=$EXTRACT(SRSHEMP,1,11)_" 14"
SET SRACNT=SRACNT+1
+2 SET TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SRSHEMP_$EXTRACT($PIECE(SRA(.11),"^",15),1,60)
LN15 SET SRSHEMP=$EXTRACT(SRSHEMP,1,11)_" 15"
SET SRACNT=SRACNT+1
+1 SET TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SRSHEMP_$JUSTIFY($EXTRACT(SRANAME,1,40),40)_$JUSTIFY(VAPA(8),20)
LN16 SET SRSHEMP=$EXTRACT(SRSHEMP,1,11)_" 16"
SET SRACNT=SRACNT+1
+1 SET SRSHEMP=SRSHEMP_$JUSTIFY(VAPA(1),35)_$JUSTIFY(VAPA(2),30)
SET TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SRSHEMP
LN17 SET SRSHEMP=$EXTRACT(SRSHEMP,1,11)_" 17"
SET SRACNT=SRACNT+1
+1 SET SRSHEMP=SRSHEMP_$JUSTIFY(VAPA(3),30)_$JUSTIFY(VAPA(4),15)
+2 KILL DA,DIC,DIQ,DR,SRY
SET X=$PIECE(VAPA(5),"^")
IF X
SET DIC=5
SET DA=X
SET DR=1
SET DIQ="SRY"
SET DIQ(0)="E"
DO EN^DIQ1
SET X=SRY(5,$PIECE(VAPA(5),"^"),1,"E")
+3 SET SRSHEMP=SRSHEMP_$JUSTIFY(X,5)
+4 SET X=$SELECT($PIECE(VAPA(11),"^",2)'="":$PIECE(VAPA(11),"^",2),1:VAPA(6))
SET TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SRSHEMP_$JUSTIFY(X,10)
LN18 SET SRSHEMP=$EXTRACT(SRSHEMP,1,11)_" 18"
SET SRACNT=SRACNT+1
+1 SET SRSHEMP=SRSHEMP_$JUSTIFY($PIECE(SRA(0),"^",18),19)_$JUSTIFY($PIECE(SRA(1),"^",13),19)
+2 SET TMP("SRA",$JOB,SRAMNUM,SRACNT,0)=SRSHEMP
+3 QUIT
