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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROASITE 692 printed Nov 22, 2024@17:51:52 Page 2
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
