SROKRET ;B'HAM ISC/MAM - KILL RETURNS, 'AL' X-REF ; [ 09/09/03 7:30 AM ]
;;3.0; Surgery ;**100**;24 Jun 93
S SRET=0,DFN=$P(^SRF(DA,0),"^") F I=0:0 S SRET=$O(^SRF("B",DFN,SRET)) Q:'SRET I $D(^SRF(SRET,29,DA,0)) K ^SRF(SRET,29,DA,0) D UPDATE
K ^SRF("AL",DA)
Q
UPDATE I '$O(^SRF(SRET,29,0)) K ^SRF(SRET,29) Q
S CNT=0 F I=0:0 S CNT=$O(^SRF(SRET,29,CNT)) Q:'CNT S SRET1=CNT
S $P(^SRF(SRET,29,0),"^",3)=SRET1,$P(^SRF(SRET,29,0),"^",4)=$P(^(0),"^",4)-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROKRET 467 printed Dec 13, 2024@02:44:02 Page 2
SROKRET ;B'HAM ISC/MAM - KILL RETURNS, 'AL' X-REF ; [ 09/09/03 7:30 AM ]
+1 ;;3.0; Surgery ;**100**;24 Jun 93
+2 SET SRET=0
SET DFN=$PIECE(^SRF(DA,0),"^")
FOR I=0:0
SET SRET=$ORDER(^SRF("B",DFN,SRET))
if 'SRET
QUIT
IF $DATA(^SRF(SRET,29,DA,0))
KILL ^SRF(SRET,29,DA,0)
DO UPDATE
+3 KILL ^SRF("AL",DA)
+4 QUIT
UPDATE IF '$ORDER(^SRF(SRET,29,0))
KILL ^SRF(SRET,29)
QUIT
+1 SET CNT=0
FOR I=0:0
SET CNT=$ORDER(^SRF(SRET,29,CNT))
if 'CNT
QUIT
SET SRET1=CNT
+2 SET $PIECE(^SRF(SRET,29,0),"^",3)=SRET1
SET $PIECE(^SRF(SRET,29,0),"^",4)=$PIECE(^(0),"^",4)-1
+3 QUIT