19 lines
1.1 KiB
Mathematica
19 lines
1.1 KiB
Mathematica
|
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
|