SROACPM2 ;BIR/MAM - LAB INFO ;03/29/04
;;3.0; Surgery ;**125,153,174**;24 Jun 93;Build 8
F SHEMP=201,202,202.1 S SRA(SHEMP)=$G(^SRF(SRTN,SHEMP))
S SHEMP=$P(SRA(201),"^",21),SRAO(1)=SHEMP_"^^457^457.1" S X=$P(SRA(202),"^",21) I X="NS" S $P(SRAO(1),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(1),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",25),SRAO(2)=SHEMP_"^^461^461.1" S X=$P(SRA(202),"^",25) I X="NS" S $P(SRAO(2),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(2),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",26),SRAO(3)=SHEMP_"^^462^462.1" S X=$P(SRA(202),"^",26) I X="NS" S $P(SRAO(3),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(3),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",22),SRAO(4)=SHEMP_"^^458^458.1" S X=$P(SRA(202),"^",22) I X="NS" S $P(SRAO(4),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(4),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",23),SRAO(5)=SHEMP_"^^459^459.1" S X=$P(SRA(202),"^",23) I X="NS" S $P(SRAO(5),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(5),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",24),SRAO(6)=SHEMP_"^^460^460.1" S X=$P(SRA(202),"^",24) I X="NS" S $P(SRAO(6),"^",2)="NS"
I X D DATE S SHEMP="("_Y_")",$P(SRAO(6),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",4),SRAO(7)=SHEMP_"^^223^290" S X=$P(SRA(202),"^",4) I X D DATE S SHEMP="("_Y_")",$P(SRAO(7),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",8),SRAO(8)=SHEMP_"^^225^292" S X=$P(SRA(202),"^",8) I X D DATE S SHEMP="("_Y_")",$P(SRAO(8),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",20),SRAO(9)=SHEMP_"^^219^239" S X=$P(SRA(202),"^",20) I X D DATE S SHEMP="("_Y_")",$P(SRAO(9),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",28),SRAO(10)=SHEMP_"^^504^504.1" S X=$P(SRA(202.1),"^") I X D DATE S SHEMP="("_Y_")",$P(SRAO(10),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",29),SRAO(11)=SHEMP_"^^507^507.1" S X=$P(SRA(202.1),"^",2) I X D DATE S SHEMP="("_Y_")",$P(SRAO(11),"^",2)=SHEMP
K SRA
Q
DATE S Y=X X ^DD("DD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROACPM2 1885 printed Sep 23, 2025@20:16:44 Page 2
SROACPM2 ;BIR/MAM - LAB INFO ;03/29/04
+1 ;;3.0; Surgery ;**125,153,174**;24 Jun 93;Build 8
+2 FOR SHEMP=201,202,202.1
SET SRA(SHEMP)=$GET(^SRF(SRTN,SHEMP))
+3 SET SHEMP=$PIECE(SRA(201),"^",21)
SET SRAO(1)=SHEMP_"^^457^457.1"
SET X=$PIECE(SRA(202),"^",21)
IF X="NS"
SET $PIECE(SRAO(1),"^",2)="NS"
+4 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(1),"^",2)=SHEMP
+5 SET SHEMP=$PIECE(SRA(201),"^",25)
SET SRAO(2)=SHEMP_"^^461^461.1"
SET X=$PIECE(SRA(202),"^",25)
IF X="NS"
SET $PIECE(SRAO(2),"^",2)="NS"
+6 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(2),"^",2)=SHEMP
+7 SET SHEMP=$PIECE(SRA(201),"^",26)
SET SRAO(3)=SHEMP_"^^462^462.1"
SET X=$PIECE(SRA(202),"^",26)
IF X="NS"
SET $PIECE(SRAO(3),"^",2)="NS"
+8 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(3),"^",2)=SHEMP
+9 SET SHEMP=$PIECE(SRA(201),"^",22)
SET SRAO(4)=SHEMP_"^^458^458.1"
SET X=$PIECE(SRA(202),"^",22)
IF X="NS"
SET $PIECE(SRAO(4),"^",2)="NS"
+10 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(4),"^",2)=SHEMP
+11 SET SHEMP=$PIECE(SRA(201),"^",23)
SET SRAO(5)=SHEMP_"^^459^459.1"
SET X=$PIECE(SRA(202),"^",23)
IF X="NS"
SET $PIECE(SRAO(5),"^",2)="NS"
+12 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(5),"^",2)=SHEMP
+13 SET SHEMP=$PIECE(SRA(201),"^",24)
SET SRAO(6)=SHEMP_"^^460^460.1"
SET X=$PIECE(SRA(202),"^",24)
IF X="NS"
SET $PIECE(SRAO(6),"^",2)="NS"
+14 IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(6),"^",2)=SHEMP
+15 SET SHEMP=$PIECE(SRA(201),"^",4)
SET SRAO(7)=SHEMP_"^^223^290"
SET X=$PIECE(SRA(202),"^",4)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(7),"^",2)=SHEMP
+16 SET SHEMP=$PIECE(SRA(201),"^",8)
SET SRAO(8)=SHEMP_"^^225^292"
SET X=$PIECE(SRA(202),"^",8)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(8),"^",2)=SHEMP
+17 SET SHEMP=$PIECE(SRA(201),"^",20)
SET SRAO(9)=SHEMP_"^^219^239"
SET X=$PIECE(SRA(202),"^",20)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(9),"^",2)=SHEMP
+18 SET SHEMP=$PIECE(SRA(201),"^",28)
SET SRAO(10)=SHEMP_"^^504^504.1"
SET X=$PIECE(SRA(202.1),"^")
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(10),"^",2)=SHEMP
+19 SET SHEMP=$PIECE(SRA(201),"^",29)
SET SRAO(11)=SHEMP_"^^507^507.1"
SET X=$PIECE(SRA(202.1),"^",2)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(11),"^",2)=SHEMP
+20 KILL SRA
+21 QUIT
DATE SET Y=X
XECUTE ^DD("DD")
+1 QUIT
