SROASITE.m

SROASITE ;BIR/SLM-Update Risk Assessment Transmission Status and Date [ 01/30/95  2:12 PM ]

 ;;3.0; Surgery ;**38,54,62**;24 Jun 93

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

 S TL=TL-2,X=$E(SRAUD(1),55,66) D ^%DT S SRD=Y

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

 .I $P($G(^SRF(SRC,"RA")),"^")=""!($P($G(^SRF(SRC,"RA")),"^",2)="C") K DR S DIE=130,DA=SRC S DR="905///T" D ^DIE K DR,DIE,SRC Q

 .I $P($G(^SRF(SRC,"RA")),"^",2)="N" S SRRT=$P($G(^SRF(SRC,"RA")),"^",3) K DR S DIE=130,DA=SRC S DR="260.1///"_SRD_";235///T;905///T" D ^DIE K DR I SRRT'=1 S DR="260///"_SRD D ^DIE K DR,DIE,SRC Q

 K SRAUD,Y,SRD,SRC

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

 Q

SROASITE  ;BIR/SLM-Update Risk Assessment Transmission Status and Date [ 01/30/95  2:12 PM ]

 +1       ;;3.0; Surgery ;**38,54,62**;24 Jun 93

 +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-2

           SET X=$EXTRACT(SRAUD(1),55,66)

           DO ^%DT

           SET SRD=Y

 +4        FOR J=3:1:TL

               SET SRC=$TRANSLATE($EXTRACT(SRAUD(J),13,19)," ","")

               Begin DoDot:1

 +5                IF $PIECE($GET(^SRF(SRC,"RA")),"^")=""!($PIECE($GET(^SRF(SRC,"RA")),"^",2)="C")

                       KILL DR

                       SET DIE=130

                       SET DA=SRC

                       SET DR="905///T"

                       DO ^DIE

                       KILL DR,DIE,SRC

                       QUIT 

 +6                IF $PIECE($GET(^SRF(SRC,"RA")),"^",2)="N"

                       SET SRRT=$PIECE($GET(^SRF(SRC,"RA")),"^",3)

                       KILL DR

                       SET DIE=130

                       SET DA=SRC

                       SET DR="260.1///"_SRD_";235///T;905///T"

                       DO ^DIE

                       KILL DR

                       IF SRRT'=1

                           SET DR="260///"_SRD

                           DO ^DIE

                           KILL DR,DIE,SRC

                           QUIT 

               End DoDot:1

 +7        KILL SRAUD,Y,SRD,SRC

 +8        SET XMSER="S."_XQSOP

           SET XMZ=XQMSG

           DO REMSBMSG^XMA1C

 +9        QUIT