SRORTRN ;BIR/MAM - PRINT RETURNS ; [ 12/16/98 12:12 PM ]
;;3.0; Surgery ;**88**;24 Jun 93
K SRRET,SRURET S (SRRET,SRURET)=0 S SRET=0 F S SRET=$O(^SRF(SRTN,29,SRET)) Q:'SRET D TYPE
W !!,"Number of Returns to O.R. Related to Index Procedure: "_SRRET S X=0 F S X=$O(SRRET(X)) Q:'X W !,?10,"CPT Code: "_SRRET(X)
W !!,"Number of Returns to O.R. Unrelated to Index Procedure: "_SRURET S X=0 F S X=$O(SRURET(X)) Q:'X W !,?10,"CPT Code: "_SRURET(X)
Q
TYPE ; set arrays to print
S X=^SRF(SRTN,29,SRET,0),CASE=$P(X,"^"),TYPE=$P(X,"^",3),CPT=$P(^SRF(CASE,"OP"),"^",2) I 'CPT Q
S CPT=$P($$CPT^ICPTCOD(CPT),"^",2)
I TYPE="R" S SRRET=SRRET+1,SRRET(SRRET)=CPT Q
S SRURET=SRURET+1,SRURET(SRURET)=CPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRORTRN 717 printed Sep 23, 2025@20:22:21 Page 2
SRORTRN ;BIR/MAM - PRINT RETURNS ; [ 12/16/98 12:12 PM ]
+1 ;;3.0; Surgery ;**88**;24 Jun 93
+2 KILL SRRET,SRURET
SET (SRRET,SRURET)=0
SET SRET=0
FOR
SET SRET=$ORDER(^SRF(SRTN,29,SRET))
if 'SRET
QUIT
DO TYPE
+3 WRITE !!,"Number of Returns to O.R. Related to Index Procedure: "_SRRET
SET X=0
FOR
SET X=$ORDER(SRRET(X))
if 'X
QUIT
WRITE !,?10,"CPT Code: "_SRRET(X)
+4 WRITE !!,"Number of Returns to O.R. Unrelated to Index Procedure: "_SRURET
SET X=0
FOR
SET X=$ORDER(SRURET(X))
if 'X
QUIT
WRITE !,?10,"CPT Code: "_SRURET(X)
+5 QUIT
TYPE ; set arrays to print
+1 SET X=^SRF(SRTN,29,SRET,0)
SET CASE=$PIECE(X,"^")
SET TYPE=$PIECE(X,"^",3)
SET CPT=$PIECE(^SRF(CASE,"OP"),"^",2)
IF 'CPT
QUIT
+2 SET CPT=$PIECE($$CPT^ICPTCOD(CPT),"^",2)
+3 IF TYPE="R"
SET SRRET=SRRET+1
SET SRRET(SRRET)=CPT
QUIT
+4 SET SRURET=SRURET+1
SET SRURET(SRURET)=CPT
+5 QUIT
