source: WorldVistAEHR/trunk/r/SURGERY-SR/SROUTLN.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 565 bytes
RevLine 
[613]1SROUTLN ;BIR/SJA - UTILITY ROUTINE ;03/14/05
2 ;;3.0; Surgery ;**142**;24 Jun 93
3 ;
4 Q
5PROC ; put procedures and CPT code in array for display
6 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:"???")
7 I Y'="???" D SSPRIN^SROCPT0
8 S SRPROC(K)="CPT Codes: "_Y
9OTH S SRDA=0 F S SRDA=$O(^SRO(136,SRTN,3,SRDA)) Q:'SRDA D
10 .S Y=$P($G(^SRO(136,SRTN,3,SRDA,0)),"^"),Y=$S(Y:$P($$CPT^ICPTCOD(Y),"^",2),1:"???")
11 .I Y'="???" D SSOTH^SROCPT0
12 .I $L(Y)+$L(SRPROC(K))'>SRL S SRPROC(K)=SRPROC(K)_", "_Y Q
13 .S K=K+1,SRPROC(K)=Y
14 Q
Note: See TracBrowser for help on using the repository browser.