- 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 Feb 18, 2025@23:50:54 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