SROUTLN ;BIR/SJA - UTILITY ROUTINE ;03/14/05
;;3.0; Surgery ;**142**;24 Jun 93
;
Q
PROC ; put procedures and CPT code in array for display
N SRDA,X,XX,Y K SRPROC S K=1,Y=$P($G(^SRO(136,SRTN,0)),"^",2),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"???")
I Y'="???" D SSPRIN^SROCPT0
S SRPROC(K)="CPT Codes: "_Y
OTH S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
.S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"???")
.I Y'="???" D SSOTH^SROCPT0
.I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
.S K=K+1,SRPROC(K)=Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROUTLN 579 printed Sep 23, 2025@20:22:57 Page 2
SROUTLN ;BIR/SJA - UTILITY ROUTINE ;03/14/05
+1 ;;3.0; Surgery ;**142**;24 Jun 93
+2 ;
+3 QUIT
PROC ; put procedures and CPT code in array for display
+1 NEW SRDA,X,XX,Y
KILL SRPROC
SET K=1
SET Y=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
SET Y=$SELECT(Y:$PIECE($$CPT^ICPTCOD(Y),"^",2),1:"???")
+2 IF Y'="???"
DO SSPRIN^SROCPT0
+3 SET SRPROC(K)="CPT Codes: "_Y
OTH SET SRDA=0
FOR
SET SRDA=$ORDER(^SRO(136,SRTN,3,SRDA))
if 'SRDA
QUIT
Begin DoDot:1
+1 SET Y=$PIECE($GET(^SRO(136,SRTN,3,SRDA,0)),"^")
SET Y=$SELECT(Y:$PIECE($$CPT^ICPTCOD(Y),"^",2),1:"???")
+2 IF Y'="???"
DO SSOTH^SROCPT0
+3 IF $LENGTH(Y)+$LENGTH(SRPROC(K))'>SRL
SET SRPROC(K)=SRPROC(K)_", "_Y
QUIT
+4 SET K=K+1
SET SRPROC(K)=Y
End DoDot:1
+5 QUIT
