|
Last change
on this file since 1800 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
631 bytes
|
| Line | |
|---|
| 1 | SROICD ;BIR/SJA - CODE SET VERSIONING UTILITY ; [ 01/30/03 05:50 PM ]
|
|---|
| 2 | ;;3.0; Surgery ;**116,127**;24 Jun 93
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to $$ICDDX^ICDCODE supported by DBIA #3990
|
|---|
| 5 | ;
|
|---|
| 6 | ICDC(SRCODE) ; output principal ICD
|
|---|
| 7 | N SRC,SRSDATE,SRDA
|
|---|
| 8 | I $D(SRCODE),SRCODE="" Q
|
|---|
| 9 | S SRDA=$S($G(SRTN):SRTN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:"")
|
|---|
| 10 | S SRC=$$ICDDX^ICDCODE(SRCODE,$P($G(^SRF(SRDA,0)),"^",9))
|
|---|
| 11 | Q $P(SRC,"^",2,4)
|
|---|
| 12 | ;
|
|---|
| 13 | ACTIV(SRTN,SRCODE) ; screen for active ICD codes
|
|---|
| 14 | K ICDVDT
|
|---|
| 15 | N SROK,SRSDATE S SROK=1,SRSDATE=DT
|
|---|
| 16 | I $G(SRTN) S SRSDATE=$E($P(^SRF(SRTN,0),"^",9),1,7)
|
|---|
| 17 | S SROK=$P($$ICDDX^ICDCODE(SRCODE,SRSDATE),"^",10)
|
|---|
| 18 | S ICDVDT=SRSDATE
|
|---|
| 19 | Q SROK
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
