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