SRORTRN.m

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 ---SRORTRN   717     printed  Apr 09, 2024@21:42:29                                                                                                                                                                                                      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