ONCOANC5 ;Hines OIFO/GWB - BUILDS FREE TEXT PORTION OF STATE REPORTING ;11 MAR 96
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
SHTXT Q:AASTYPNC'="A" K AASTXB S $P(AASTXB," ",351)=""
S (AAS("S",1),AAS("S",2))=40,AAS("S",3)=100,AAS("S",4)=50
F CN=1:1:3 S AASY(CN)=$P($G(^ONCO(165.5,D0,8)),U,CN) D
. S AASY(CN)=AASY(CN)_$E(AASTXB,1,AAS("S",CN)-$L(AASY(CN)))
S AASY(4)=$P($G(^ONCO(165.5,D0,0)),U,17)
S:AASY(4)>0 AASY(4)=$E($P($G(^ONCO(160.19,AASY(4),0)),U,2),1,50)
S AASY(4)=AASY(4)_$E(AASTXB,1,AAS("S",4)-$L(AASY(4)))
WP F CN=9,11,12,13,22 S AAS("S",CN)=250
S (AAS("S",10),AAS("S",17),AAS("S",18))=200
S (AAS("S",14),AAS("S",15),AAS("S",16))=150
S (AAS("S",20),AAS("S",21))=100,AAS("S",19)=350
F CN=9:1:22 S CNT=0,AASY(CN)="" D
.I '$D(^ONCO(165.5,D0,CN)) S AASY(CN)=$E(AASTXB,1,AAS("S",CN)) Q
.S CNT=0 F S CNT=$O(^ONCO(165.5,D0,CN,CNT)) Q:CNT'>0!($L(AASY(CN))'<AAS("S",CN)) D
..S AAS(CN,CNT)=$G(^ONCO(165.5,D0,CN,CNT,0))
..I $L(AASY(CN))+$L(AAS(CN,CNT))>AAS("S",CN) S AASY(CN)=AASY(CN)_$E(AAS(CN,CNT),1,AAS("S",CN)-$L(AASY(CN))) Q
..S AASY(CN)=AASY(CN)_AAS(CN,CNT)
.S AASY(CN)=$E(AASY(CN)_$E(AASTXB,1,AAS("S",CN)-$L(AASY(CN))),1,AAS("S",CN))
K AAS
SETTMP S ^TMP($J,D0,1075)=$E(AASTXB,1,75),^TMP($J,D0,1150)=$E(AASTXB,1,75)
S ^TMP($J,D0,1225)=$E(AASY(10),1,75)
S ^TMP($J,D0,1300)=$E(AASY(10),76,150)
S ^TMP($J,D0,1375)=$E(AASY(10),151,200)_$E(AASY(11),1,25)
S ^TMP($J,D0,1450)=$E(AASY(11),26,100)
S ^TMP($J,D0,1525)=$E(AASY(11),101,175)
S ^TMP($J,D0,1600)=$E(AASY(11),176,250)
S ^TMP($J,D0,1675)=$E(AASY(12),1,75)
S ^TMP($J,D0,1750)=$E(AASY(12),76,150)
S ^TMP($J,D0,1825)=$E(AASY(12),151,225)
S ^TMP($J,D0,1900)=$E(AASY(12),226,250)_$E(AASY(22),1,50)
S ^TMP($J,D0,1975)=$E(AASY(22),51,125)
S ^TMP($J,D0,2050)=$E(AASY(22),126,200)
S ^TMP($J,D0,2125)=$E(AASY(22),201,250)_$E(AASY(9),1,25)
S ^TMP($J,D0,2200)=$E(AASY(9),26,100)
S ^TMP($J,D0,2275)=$E(AASY(9),101,175)
S ^TMP($J,D0,2350)=$E(AASY(9),176,250)
S ^TMP($J,D0,2425)=$E(AASY(13),1,75)
S ^TMP($J,D0,2500)=$E(AASY(13),76,150)
S ^TMP($J,D0,2575)=$E(AASY(13),151,225)
S ^TMP($J,D0,2650)=$E(AASY(13),226,250)_$E(AASY(1),1,40)_$E(AASY(2),1,10)
S ^TMP($J,D0,2725)=$E(AASY(2),11,40)_$E(AASTXB,1,45)
S ^TMP($J,D0,2800)=$E(AASTXB,1,75)
S ^TMP($J,D0,2875)=$E(AASTXB,1,75)
S ^TMP($J,D0,2950)=$E(AASTXB,1,75)
S ^TMP($J,D0,3025)=$E(AASTXB,1,30)_$E(AASY(14),1,45)
S ^TMP($J,D0,3100)=$E(AASY(14),46,120)
S ^TMP($J,D0,3175)=$E(AASY(14),121,150)_$E(AASY(15),1,45)
S ^TMP($J,D0,3250)=$E(AASY(15),46,120)
S ^TMP($J,D0,3325)=$E(AASY(15),121,150)_$E(AASY(16),1,45)
S ^TMP($J,D0,3400)=$E(AASY(16),46,120)
S ^TMP($J,D0,3475)=$E(AASY(16),121,150)_$E(AASY(17),1,45)
S ^TMP($J,D0,3550)=$E(AASY(17),46,120)
S ^TMP($J,D0,3625)=$E(AASY(17),121,195)
S ^TMP($J,D0,3700)=$E(AASY(17),196,200)_$E(AASY(18),1,70)
S ^TMP($J,D0,3775)=$E(AASY(18),71,145)
S ^TMP($J,D0,3850)=$E(AASY(18),146,200)_$E(AASY(20),1,20)
S ^TMP($J,D0,3925)=$E(AASY(20),21,95)
S ^TMP($J,D0,4000)=$E(AASY(20),96,100)_$E(AASY(21),1,70)
S ^TMP($J,D0,4075)=$E(AASY(21),71,100)_$E(AASY(19),1,45)
S ^TMP($J,D0,4150)=$E(AASY(19),46,120)
S ^TMP($J,D0,4225)=$E(AASY(19),121,195)
S ^TMP($J,D0,4300)=$E(AASY(19),196,270)
S ^TMP($J,D0,4375)=$E(AASY(19),271,345)
S ^TMP($J,D0,4450)=$E(AASY(19),346,350)_$E(AASY(3),1,70)
S ^TMP($J,D0,4525)=$E(AASY(3),71,100)_$E(AASY(4),1,45)
S ^TMP($J,D0,4600)=$E(AASY(4),46,50)_$E(AASTXB,1,70)
S ^TMP($J,D0,4675)=$E(AASTXB,1,75)
K AAS,AASY,AASTXB,CN,CNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOANC5 3497 printed Nov 22, 2024@17:34:27 Page 2
ONCOANC5 ;Hines OIFO/GWB - BUILDS FREE TEXT PORTION OF STATE REPORTING ;11 MAR 96
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
SHTXT if AASTYPNC'="A"
QUIT
KILL AASTXB
SET $PIECE(AASTXB," ",351)=""
+1 SET (AAS("S",1),AAS("S",2))=40
SET AAS("S",3)=100
SET AAS("S",4)=50
+2 FOR CN=1:1:3
SET AASY(CN)=$PIECE($GET(^ONCO(165.5,D0,8)),U,CN)
Begin DoDot:1
+3 SET AASY(CN)=AASY(CN)_$EXTRACT(AASTXB,1,AAS("S",CN)-$LENGTH(AASY(CN)))
End DoDot:1
+4 SET AASY(4)=$PIECE($GET(^ONCO(165.5,D0,0)),U,17)
+5 if AASY(4)>0
SET AASY(4)=$EXTRACT($PIECE($GET(^ONCO(160.19,AASY(4),0)),U,2),1,50)
+6 SET AASY(4)=AASY(4)_$EXTRACT(AASTXB,1,AAS("S",4)-$LENGTH(AASY(4)))
WP FOR CN=9,11,12,13,22
SET AAS("S",CN)=250
+1 SET (AAS("S",10),AAS("S",17),AAS("S",18))=200
+2 SET (AAS("S",14),AAS("S",15),AAS("S",16))=150
+3 SET (AAS("S",20),AAS("S",21))=100
SET AAS("S",19)=350
+4 FOR CN=9:1:22
SET CNT=0
SET AASY(CN)=""
Begin DoDot:1
+5 IF '$DATA(^ONCO(165.5,D0,CN))
SET AASY(CN)=$EXTRACT(AASTXB,1,AAS("S",CN))
QUIT
+6 SET CNT=0
FOR
SET CNT=$ORDER(^ONCO(165.5,D0,CN,CNT))
if CNT'>0!($LENGTH(AASY(CN))'<AAS("S",CN))
QUIT
Begin DoDot:2
+7 SET AAS(CN,CNT)=$GET(^ONCO(165.5,D0,CN,CNT,0))
+8 IF $LENGTH(AASY(CN))+$LENGTH(AAS(CN,CNT))>AAS("S",CN)
SET AASY(CN)=AASY(CN)_$EXTRACT(AAS(CN,CNT),1,AAS("S",CN)-$LENGTH(AASY(CN)))
QUIT
+9 SET AASY(CN)=AASY(CN)_AAS(CN,CNT)
End DoDot:2
+10 SET AASY(CN)=$EXTRACT(AASY(CN)_$EXTRACT(AASTXB,1,AAS("S",CN)-$LENGTH(AASY(CN))),1,AAS("S",CN))
End DoDot:1
+11 KILL AAS
SETTMP SET ^TMP($JOB,D0,1075)=$EXTRACT(AASTXB,1,75)
SET ^TMP($JOB,D0,1150)=$EXTRACT(AASTXB,1,75)
+1 SET ^TMP($JOB,D0,1225)=$EXTRACT(AASY(10),1,75)
+2 SET ^TMP($JOB,D0,1300)=$EXTRACT(AASY(10),76,150)
+3 SET ^TMP($JOB,D0,1375)=$EXTRACT(AASY(10),151,200)_$EXTRACT(AASY(11),1,25)
+4 SET ^TMP($JOB,D0,1450)=$EXTRACT(AASY(11),26,100)
+5 SET ^TMP($JOB,D0,1525)=$EXTRACT(AASY(11),101,175)
+6 SET ^TMP($JOB,D0,1600)=$EXTRACT(AASY(11),176,250)
+7 SET ^TMP($JOB,D0,1675)=$EXTRACT(AASY(12),1,75)
+8 SET ^TMP($JOB,D0,1750)=$EXTRACT(AASY(12),76,150)
+9 SET ^TMP($JOB,D0,1825)=$EXTRACT(AASY(12),151,225)
+10 SET ^TMP($JOB,D0,1900)=$EXTRACT(AASY(12),226,250)_$EXTRACT(AASY(22),1,50)
+11 SET ^TMP($JOB,D0,1975)=$EXTRACT(AASY(22),51,125)
+12 SET ^TMP($JOB,D0,2050)=$EXTRACT(AASY(22),126,200)
+13 SET ^TMP($JOB,D0,2125)=$EXTRACT(AASY(22),201,250)_$EXTRACT(AASY(9),1,25)
+14 SET ^TMP($JOB,D0,2200)=$EXTRACT(AASY(9),26,100)
+15 SET ^TMP($JOB,D0,2275)=$EXTRACT(AASY(9),101,175)
+16 SET ^TMP($JOB,D0,2350)=$EXTRACT(AASY(9),176,250)
+17 SET ^TMP($JOB,D0,2425)=$EXTRACT(AASY(13),1,75)
+18 SET ^TMP($JOB,D0,2500)=$EXTRACT(AASY(13),76,150)
+19 SET ^TMP($JOB,D0,2575)=$EXTRACT(AASY(13),151,225)
+20 SET ^TMP($JOB,D0,2650)=$EXTRACT(AASY(13),226,250)_$EXTRACT(AASY(1),1,40)_$EXTRACT(AASY(2),1,10)
+21 SET ^TMP($JOB,D0,2725)=$EXTRACT(AASY(2),11,40)_$EXTRACT(AASTXB,1,45)
+22 SET ^TMP($JOB,D0,2800)=$EXTRACT(AASTXB,1,75)
+23 SET ^TMP($JOB,D0,2875)=$EXTRACT(AASTXB,1,75)
+24 SET ^TMP($JOB,D0,2950)=$EXTRACT(AASTXB,1,75)
+25 SET ^TMP($JOB,D0,3025)=$EXTRACT(AASTXB,1,30)_$EXTRACT(AASY(14),1,45)
+26 SET ^TMP($JOB,D0,3100)=$EXTRACT(AASY(14),46,120)
+27 SET ^TMP($JOB,D0,3175)=$EXTRACT(AASY(14),121,150)_$EXTRACT(AASY(15),1,45)
+28 SET ^TMP($JOB,D0,3250)=$EXTRACT(AASY(15),46,120)
+29 SET ^TMP($JOB,D0,3325)=$EXTRACT(AASY(15),121,150)_$EXTRACT(AASY(16),1,45)
+30 SET ^TMP($JOB,D0,3400)=$EXTRACT(AASY(16),46,120)
+31 SET ^TMP($JOB,D0,3475)=$EXTRACT(AASY(16),121,150)_$EXTRACT(AASY(17),1,45)
+32 SET ^TMP($JOB,D0,3550)=$EXTRACT(AASY(17),46,120)
+33 SET ^TMP($JOB,D0,3625)=$EXTRACT(AASY(17),121,195)
+34 SET ^TMP($JOB,D0,3700)=$EXTRACT(AASY(17),196,200)_$EXTRACT(AASY(18),1,70)
+35 SET ^TMP($JOB,D0,3775)=$EXTRACT(AASY(18),71,145)
+36 SET ^TMP($JOB,D0,3850)=$EXTRACT(AASY(18),146,200)_$EXTRACT(AASY(20),1,20)
+37 SET ^TMP($JOB,D0,3925)=$EXTRACT(AASY(20),21,95)
+38 SET ^TMP($JOB,D0,4000)=$EXTRACT(AASY(20),96,100)_$EXTRACT(AASY(21),1,70)
+39 SET ^TMP($JOB,D0,4075)=$EXTRACT(AASY(21),71,100)_$EXTRACT(AASY(19),1,45)
+40 SET ^TMP($JOB,D0,4150)=$EXTRACT(AASY(19),46,120)
+41 SET ^TMP($JOB,D0,4225)=$EXTRACT(AASY(19),121,195)
+42 SET ^TMP($JOB,D0,4300)=$EXTRACT(AASY(19),196,270)
+43 SET ^TMP($JOB,D0,4375)=$EXTRACT(AASY(19),271,345)
+44 SET ^TMP($JOB,D0,4450)=$EXTRACT(AASY(19),346,350)_$EXTRACT(AASY(3),1,70)
+45 SET ^TMP($JOB,D0,4525)=$EXTRACT(AASY(3),71,100)_$EXTRACT(AASY(4),1,45)
+46 SET ^TMP($JOB,D0,4600)=$EXTRACT(AASY(4),46,50)_$EXTRACT(AASTXB,1,70)
+47 SET ^TMP($JOB,D0,4675)=$EXTRACT(AASTXB,1,75)
+48 KILL AAS,AASY,AASTXB,CN,CNT
