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  Sep 23, 2025@20:20:29                                                                                                                                                                                                      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