SROALN1 ;BIR/MAM - LAB INFO ;01/27/06
;;3.0; Surgery ;**38,125,153,160**;24 Jun 93;Build 7
F SHEMP=201:1:204,202.1 S SRA(SHEMP)=$G(^SRF(SRTN,SHEMP))
S SHEMP=$P(SRA(203),"^",15),SRAO(1)=SHEMP_"^^444^444.1" S X=$P(SRA(204),"^",15) I X D DATE S SHEMP="("_Y_")",$P(SRAO(1),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^"),SRAO(2)=SHEMP_"^^270^304" S X=$P(SRA(202),"^") I X D DATE S SHEMP="("_Y_")",$P(SRAO(2),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",5),SRAO(3)=SHEMP_"^^224^291" S X=$P(SRA(202),"^",5) I X D DATE S SHEMP="("_Y_")",$P(SRAO(3),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",4),SRAO(4)=SHEMP_"^^223^290" S X=$P(SRA(202),"^",4) I X D DATE S SHEMP="("_Y_")",$P(SRAO(4),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",8),SRAO(5)=SHEMP_"^^225^292" S X=$P(SRA(202),"^",8) I X D DATE S SHEMP="("_Y_")",$P(SRAO(5),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",9),SRAO(6)=SHEMP_"^^228^295" S X=$P(SRA(202),"^",9) I X D DATE S SHEMP="("_Y_")",$P(SRAO(6),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",11),SRAO(7)=SHEMP_"^^227^294" S X=$P(SRA(202),"^",11) I X D DATE S SHEMP="("_Y_")",$P(SRAO(7),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",12),SRAO(8)=SHEMP_"^^229^296" S X=$P(SRA(202),"^",12) I X D DATE S SHEMP="("_Y_")",$P(SRAO(8),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",13),SRAO(9)=SHEMP_"^^230^297" S X=$P(SRA(202),"^",13) I X D DATE S SHEMP="("_Y_")",$P(SRAO(9),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",14),SRAO(10)=SHEMP_"^^234^301" S X=$P(SRA(202),"^",14) I X D DATE S SHEMP="("_Y_")",$P(SRAO(10),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",15),SRAO(11)=SHEMP_"^^231^298" S X=$P(SRA(202),"^",15) I X D DATE S SHEMP="("_Y_")",$P(SRAO(11),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",16),SRAO(12)=SHEMP_"^^233^300" S X=$P(SRA(202),"^",16) I X D DATE S SHEMP="("_Y_")",$P(SRAO(12),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",17),SRAO(13)=SHEMP_"^^232^299" S X=$P(SRA(202),"^",17) I X D DATE S SHEMP="("_Y_")",$P(SRAO(13),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",27),SRAO(14)=SHEMP_"^^487^487.1" S X=$P(SRA(202),"^",27) I X D DATE S SHEMP="("_Y_")",$P(SRAO(14),"^",2)=SHEMP
S SHEMP=$P(SRA(201),"^",28),SRAO(15)=SHEMP_"^^504^504.1" S X=$P(SRA(202.1),"^") I X D DATE S SHEMP="("_Y_")",$P(SRAO(15),"^",2)=SHEMP
K SRA
Q
DATE S Y=X X ^DD("DD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROALN1 2192 printed Sep 23, 2025@20:17:15 Page 2
SROALN1 ;BIR/MAM - LAB INFO ;01/27/06
+1 ;;3.0; Surgery ;**38,125,153,160**;24 Jun 93;Build 7
+2 FOR SHEMP=201:1:204,202.1
SET SRA(SHEMP)=$GET(^SRF(SRTN,SHEMP))
+3 SET SHEMP=$PIECE(SRA(203),"^",15)
SET SRAO(1)=SHEMP_"^^444^444.1"
SET X=$PIECE(SRA(204),"^",15)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(1),"^",2)=SHEMP
+4 SET SHEMP=$PIECE(SRA(201),"^")
SET SRAO(2)=SHEMP_"^^270^304"
SET X=$PIECE(SRA(202),"^")
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(2),"^",2)=SHEMP
+5 SET SHEMP=$PIECE(SRA(201),"^",5)
SET SRAO(3)=SHEMP_"^^224^291"
SET X=$PIECE(SRA(202),"^",5)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(3),"^",2)=SHEMP
+6 SET SHEMP=$PIECE(SRA(201),"^",4)
SET SRAO(4)=SHEMP_"^^223^290"
SET X=$PIECE(SRA(202),"^",4)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(4),"^",2)=SHEMP
+7 SET SHEMP=$PIECE(SRA(201),"^",8)
SET SRAO(5)=SHEMP_"^^225^292"
SET X=$PIECE(SRA(202),"^",8)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(5),"^",2)=SHEMP
+8 SET SHEMP=$PIECE(SRA(201),"^",9)
SET SRAO(6)=SHEMP_"^^228^295"
SET X=$PIECE(SRA(202),"^",9)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(6),"^",2)=SHEMP
+9 SET SHEMP=$PIECE(SRA(201),"^",11)
SET SRAO(7)=SHEMP_"^^227^294"
SET X=$PIECE(SRA(202),"^",11)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(7),"^",2)=SHEMP
+10 SET SHEMP=$PIECE(SRA(201),"^",12)
SET SRAO(8)=SHEMP_"^^229^296"
SET X=$PIECE(SRA(202),"^",12)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(8),"^",2)=SHEMP
+11 SET SHEMP=$PIECE(SRA(201),"^",13)
SET SRAO(9)=SHEMP_"^^230^297"
SET X=$PIECE(SRA(202),"^",13)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(9),"^",2)=SHEMP
+12 SET SHEMP=$PIECE(SRA(201),"^",14)
SET SRAO(10)=SHEMP_"^^234^301"
SET X=$PIECE(SRA(202),"^",14)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(10),"^",2)=SHEMP
+13 SET SHEMP=$PIECE(SRA(201),"^",15)
SET SRAO(11)=SHEMP_"^^231^298"
SET X=$PIECE(SRA(202),"^",15)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(11),"^",2)=SHEMP
+14 SET SHEMP=$PIECE(SRA(201),"^",16)
SET SRAO(12)=SHEMP_"^^233^300"
SET X=$PIECE(SRA(202),"^",16)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(12),"^",2)=SHEMP
+15 SET SHEMP=$PIECE(SRA(201),"^",17)
SET SRAO(13)=SHEMP_"^^232^299"
SET X=$PIECE(SRA(202),"^",17)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(13),"^",2)=SHEMP
+16 SET SHEMP=$PIECE(SRA(201),"^",27)
SET SRAO(14)=SHEMP_"^^487^487.1"
SET X=$PIECE(SRA(202),"^",27)
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(14),"^",2)=SHEMP
+17 SET SHEMP=$PIECE(SRA(201),"^",28)
SET SRAO(15)=SHEMP_"^^504^504.1"
SET X=$PIECE(SRA(202.1),"^")
IF X
DO DATE
SET SHEMP="("_Y_")"
SET $PIECE(SRAO(15),"^",2)=SHEMP
+18 KILL SRA
+19 QUIT
DATE SET Y=X
XECUTE ^DD("DD")
+1 QUIT
