- 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
- 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
