Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROUTLN

SROUTLN.m

Go to the documentation of this file.
  1. SROUTLN ;BIR/SJA - UTILITY ROUTINE ;03/14/05
  1. ;;3.0; Surgery ;**142**;24 Jun 93
  1. ;
  1. Q
  1. PROC ; put procedures and CPT code in array for display
  1. 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:"???")
  1. I Y'="???" D SSPRIN^SROCPT0
  1. S SRPROC(K)="CPT Codes: "_Y
  1. OTH S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
  1. .S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"???")
  1. .I Y'="???" D SSOTH^SROCPT0
  1. .I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
  1. .S K=K+1,SRPROC(K)=Y
  1. Q