[613] | 1 | SROSPLG2 ;B'HAM ISC/ADM - COPY INFO FROM OPERATION RECORD; 09 AUG 1993 9:57 AM ;4/12/94 08:56
|
---|
| 2 | ;;3.0; Surgery ;**28**;24 Jun 93
|
---|
| 3 | HIS I '$O(^SRF(SRTN,39,0)) G PRE
|
---|
| 4 | I '$O(^LR(LRDFN,LRSS,LRI,.2,0)) S %X="^SRF(SRTN,39,",%Y="^LR(LRDFN,LRSS,LRI,.2," D %XY^%RCR S SRN=.2
|
---|
| 5 | PRE I $O(^LR(LRDFN,LRSS,LRI,.3,0)) G FIND
|
---|
| 6 | S J=1,SRD(1)=$P($G(^SRF(SRTN,33)),"^") I SRD(1)'="" S K=0 F S K=$O(^SRF(SRTN,14,K)) Q:'K S SRD(J)=SRD(J)_",",J=J+1,SRD(J)=$P(^SRF(SRTN,14,K,0),"^")
|
---|
| 7 | I SRD(1)'="" S SRN=.3 D WP
|
---|
| 8 | FIND I '$O(^SRF(SRTN,38,0)) G POST
|
---|
| 9 | I '$O(^LR(LRDFN,LRSS,LRI,.4,0)) S %X="^SRF(SRTN,38,",%Y="^LR(LRDFN,LRSS,LRI,.4," D %XY^%RCR S SRN=.4
|
---|
| 10 | POST I $O(^LR(LRDFN,LRSS,LRI,.5,0)) Q
|
---|
| 11 | S J=1,SRD(1)=$P($G(^SRF(SRTN,34)),"^") I SRD(1)'="" S K=0 F S K=$O(^SRF(SRTN,15,K)) Q:'K S SRD(J)=SRD(J)_",",J=J+1,SRD(J)=$P(^SRF(SRTN,15,K,0),"^")
|
---|
| 12 | I SRD(1)="" Q
|
---|
| 13 | Q:SRD(1)="" S SRN=.5
|
---|
| 14 | WP S DIWL=1,DIWR=75,DIWF="",SRJ=J K ^UTILITY($J,"W") F SRK=1:1:SRJ S X=SRD(SRK) D ^DIWP
|
---|
| 15 | S J=^UTILITY($J,"W",DIWL),^LR(LRDFN,LRSS,LRI,SRN,0)="^^"_J_"^"_J_"^"_DT_"^"
|
---|
| 16 | F K=1:1:J S ^LR(LRDFN,LRSS,LRI,SRN,K,0)=^UTILITY($J,"W",DIWL,K,0)
|
---|
| 17 | K ^UTILITY($J,"W"),SRD
|
---|
| 18 | Q
|
---|