SRTPTM2.m

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 ---SRTPTM2   1186     printed  Apr 09, 2024@21:48                                                                                                                                                                                                        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