SRTPSITE.m

SRTPSITE ;BIR/SJA-UPDATE TRANSPLANT ASSESSMENT TRANSMISSION STATUS AND DATE ;05/15/08

 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27

 S TL=0 F I=1:1 X XMREC Q:XMER=-1  S SRAUD(I)=XMRG,TL=TL+1

 S TL=TL-1,X=$E(SRAUD(1),53,64) D ^%DT S SRD=Y

 F J=3:1:TL S SRC=$TR($E(SRAUD(J),15,21)," ","") D

 .S SRRT=$P($G(^SRT(SRC,"RA")),"^",3) K DR S DIE=139.5,DA=SRC S DR="188///"_SRD_";181///T" D ^DIE K DR I SRRT'=1 S DR="184///"_SRD D ^DIE K DR,DIE,SRC Q

 K SRAUD,Y,SRD,SRC

 S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C

 Q

SRTPSITE  ;BIR/SJA-UPDATE TRANSPLANT ASSESSMENT TRANSMISSION STATUS AND DATE ;05/15/08

 +1       ;;3.0; Surgery ;**167**;24 Jun 93;Build 27

 +2        SET TL=0

           FOR I=1:1

               XECUTE XMREC

               IF XMER=-1

                   QUIT 

               SET SRAUD(I)=XMRG

               SET TL=TL+1

 +3        SET TL=TL-1

           SET X=$EXTRACT(SRAUD(1),53,64)

           DO ^%DT

           SET SRD=Y

 +4        FOR J=3:1:TL

               SET SRC=$TRANSLATE($EXTRACT(SRAUD(J),15,21)," ","")

               Begin DoDot:1

 +5                SET SRRT=$PIECE($GET(^SRT(SRC,"RA")),"^",3)

                   KILL DR

                   SET DIE=139.5

                   SET DA=SRC

                   SET DR="188///"_SRD_";181///T"

                   DO ^DIE

                   KILL DR

                   IF SRRT'=1

                       SET DR="184///"_SRD

                       DO ^DIE

                       KILL DR,DIE,SRC

                       QUIT 

               End DoDot:1

 +6        KILL SRAUD,Y,SRD,SRC

 +7        SET XMSER="S."_XQSOP

           SET XMZ=XQMSG

           DO REMSBMSG^XMA1C

 +8        QUIT