- LROSPLG2 ;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[HLROSPLG2 1127 printed Jan 18, 2025@03:19:46 Page 2
- LROSPLG2 ;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