SROSPLG2 ;B'HAM ISC/ADM - COPY INFO FROM OPERATION RECORD; 09 AUG 1993  9:57 AM ;4/12/94  08:56
 ;;3.0; Surgery ;**28**;24 Jun 93
HIS I '$O(^SRF(SRTN,39,0)) G PRE
 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
PRE I $O(^LR(LRDFN,LRSS,LRI,.3,0)) G FIND
 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),"^")
 I SRD(1)'="" S SRN=.3 D WP
FIND I '$O(^SRF(SRTN,38,0)) G POST
 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
POST I $O(^LR(LRDFN,LRSS,LRI,.5,0)) Q
 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),"^")
 I SRD(1)="" Q
 Q:SRD(1)=""  S SRN=.5
WP S DIWL=1,DIWR=75,DIWF="",SRJ=J K ^UTILITY($J,"W") F SRK=1:1:SRJ S X=SRD(SRK) D ^DIWP
 S J=^UTILITY($J,"W",DIWL),^LR(LRDFN,LRSS,LRI,SRN,0)="^^"_J_"^"_J_"^"_DT_"^"
 F K=1:1:J S ^LR(LRDFN,LRSS,LRI,SRN,K,0)=^UTILITY($J,"W",DIWL,K,0)
 K ^UTILITY($J,"W"),SRD
 Q