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