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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROSPLG2 1127 printed Dec 13, 2024@02:46:08 Page 2
SROSPLG2 ;B'HAM ISC/ADM - COPY INFO FROM OPERATION RECORD; 09 AUG 1993 9:57 AM ;4/12/94 08:56
+1 ;;3.0; Surgery ;**28**;24 Jun 93
HIS IF '$ORDER(^SRF(SRTN,39,0))
GOTO PRE
+1 IF '$ORDER(^LR(LRDFN,LRSS,LRI,.2,0))
SET %X="^SRF(SRTN,39,"
SET %Y="^LR(LRDFN,LRSS,LRI,.2,"
DO %XY^%RCR
SET SRN=.2
PRE IF $ORDER(^LR(LRDFN,LRSS,LRI,.3,0))
GOTO FIND
+1 SET J=1
SET SRD(1)=$PIECE($GET(^SRF(SRTN,33)),"^")
IF SRD(1)'=""
SET K=0
FOR
SET K=$ORDER(^SRF(SRTN,14,K))
if 'K
QUIT
SET SRD(J)=SRD(J)_","
SET J=J+1
SET SRD(J)=$PIECE(^SRF(SRTN,14,K,0),"^")
+2 IF SRD(1)'=""
SET SRN=.3
DO WP
FIND IF '$ORDER(^SRF(SRTN,38,0))
GOTO POST
+1 IF '$ORDER(^LR(LRDFN,LRSS,LRI,.4,0))
SET %X="^SRF(SRTN,38,"
SET %Y="^LR(LRDFN,LRSS,LRI,.4,"
DO %XY^%RCR
SET SRN=.4
POST IF $ORDER(^LR(LRDFN,LRSS,LRI,.5,0))
QUIT
+1 SET J=1
SET SRD(1)=$PIECE($GET(^SRF(SRTN,34)),"^")
IF SRD(1)'=""
SET K=0
FOR
SET K=$ORDER(^SRF(SRTN,15,K))
if 'K
QUIT
SET SRD(J)=SRD(J)_","
SET J=J+1
SET SRD(J)=$PIECE(^SRF(SRTN,15,K,0),"^")
+2 IF SRD(1)=""
QUIT
+3 if SRD(1)=""
QUIT
SET SRN=.5
WP SET DIWL=1
SET DIWR=75
SET DIWF=""
SET SRJ=J
KILL ^UTILITY($JOB,"W")
FOR SRK=1:1:SRJ
SET X=SRD(SRK)
DO ^DIWP
+1 SET J=^UTILITY($JOB,"W",DIWL)
SET ^LR(LRDFN,LRSS,LRI,SRN,0)="^^"_J_"^"_J_"^"_DT_"^"
+2 FOR K=1:1:J
SET ^LR(LRDFN,LRSS,LRI,SRN,K,0)=^UTILITY($JOB,"W",DIWL,K,0)
+3 KILL ^UTILITY($JOB,"W"),SRD
+4 QUIT
