SROACPM2.m

SROACPM2 ;BIR/MAM - LAB INFO ;03/29/04

 ;;3.0; Surgery ;**125,153**;24 Jun 93;Build 11

 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

 K SRA

 Q

DATE S Y=X X ^DD("DD")

 Q

SROACPM2  ;BIR/MAM - LAB INFO ;03/29/04

 +1       ;;3.0; Surgery ;**125,153**;24 Jun 93;Build 11

 +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       KILL SRA

 +20       QUIT 

DATE       SET Y=X

           XECUTE ^DD("DD")

 +1        QUIT