- ONCOANC1 ;Hines OIFO/GWB - CONTINUE ONCOANC2 ;05/03/12
- ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
- ;rvd - 05/03/12 p56. Use ICD API (#3990) instead of direct global read.
- ;
- AASTEOD ; STAGE/EXTENT OF DISEASE
- S AASEODS=$P(AAS1655("N2"),U,17) S AASEODS=$S(AASEODS="":9,AASEODS<0:9,AASEODS>9:9,AASEODS=8:9,1:AASEODS)
- S AASEODT=$P(AAS1655("N2"),U,9) S AASEODT=$S(AASEODT="":999,AASEODT[".":999,AASEODT<0:999,AASEODT>999:999,1:AASEODT)
- S:$L(AASEODT)<3 AASEODT=$E(AASZERO,1,3-$L(AASEODT))_AASEODT
- S AASEODE=$P(AAS1655("N2"),U,10) S AASEODE=$S(AASEODE="":" ",AASEODE<0:" ",AASEODE>99:" ",1:AASEODE)
- S:$L(AASEODE)<2 AASEODE=$E(AASZERO,1,2-$L(AASEODE))_AASEODE
- S AASEODL=$P(AAS1655("N2"),U,11) S AASEODL=$S(AASEODL="":" ",AASEODL<0:" ",AASEODL>9:" ",1:AASEODL)
- S AASNP=$P(AAS1655("N2"),U,12) S AASNP=$S(AASNP="":99,AASNP[".":99,AASNP<0:99,AASNP>99:99,1:AASNP)
- S:$L(AASNP)<2 AASNP=$E(AASZERO,1,2-$L(AASNP))_AASNP
- S AASNE=$P(AAS1655("N2"),U,13) S AASNE=$S(AASNE="":99,AASNE[".":99,AASNE<0:99,AASNE>99:99,1:AASNE)
- S:$L(AASNE)<2 AASNE=$E(AASZERO,1,2-$L(AASNE))_AASNE
- S AASTNME=$$EDT^ONCOANC3($E(AASDXDT,7,8)) ;(AASTNME=2
- N AASTC,AASNC,AASMC,AASAJSM,AASTC2,AASNC2,AASMC2,AASJSM2
- D TNM^ONCOANC3(.AASTC,.AASNC,.AASMC,.AASAJSM,.AASTC2,.AASNC2,.AASMC2,.AASJSM2)
- S AASITME=$$MET^ONCOANC3(AAS1655("N2"))
- S:$L(AASITME)<3 AASITME=AASITME_$E(AASBLNK,1,3-$L(AASITME))
- S AASRT=$P(AAS1655("N3"),U,28) S AASRT=$S(AASRT="":" ",AASRT<0:" ",AASRT>9:" ",1:AASRT)
- I AASRT>2&(AASRT<9) S AASRT=" "
- S AASTM1=$P(AAS1655("N24"),U,2) S AASTM1=$S(AASTM1="":" ",1:$P(^ONCO(164.15,AASTM1,0),U))
- S AASTM2=$P(AAS1655("N24"),U,3) S AASTM2=$S(AASTM2="":" ",1:$P(^ONCO(164.15,AASTM2,0),U))
- S ^TMP($J,D0,225)=^TMP($J,D0,225)_AASEODS_" "_AASEODT_AASEODE_AASEODL_AASNP_AASNE_$E(AASBLNK,1,19)_AASTC_AASNC_AASMC_AASAJSM_AASTC2_AASNC2_AASMC2_AASJSM2
- S ^TMP($J,D0,299)=AASTNME_AASITME_AASRT_$E(AASBLNK,1,4)_AASTM1_AASTM2_$E(AASBLNK,1,12)
- AASRXTR ; TREATMENT(RX)-ENTIRE(SUMMARY) FIRST COURSE
- S AASRTR=1
- S AASRDSR=$$AASDC^ONCOANC4($P(AAS1655("N3"),U))
- S AASRDRA=$$AASDC^ONCOANC4($P(AAS1655("N3"),U,4))
- S AASRDCH=$$AASDC^ONCOANC4($P(AAS1655("N3"),U,11))
- S AASRDHO=$$AASDC^ONCOANC4($P(AAS1655("N3"),U,14))
- S AASRDBR=$$AASDC^ONCOANC4($P(AAS1655("N3"),U,17))
- S AASRDOT=$$AASDC^ONCOANC4($P(AAS1655("N3"),U,23))
- S AASX=$O(^ONCO(165.5,"ATX",D0,0)) S:AASX'="" AASX=$E(AASX,1,7)
- S AASRXBDT=$$AASDC^ONCOANC4(AASX,"ZERO")
- S AASRXREA=$P(AAS1655("N3"),U,26) I AASRXREA=""!(AASRXREA<0)!(AASRXREA>9)!(AASRXREA>2&(AASRXREA<6)) S AASRXREA=9
- S AASRXCN=$P(AAS1655("N3"),U,10) I AASRXCN=""!(AASRXCN<0)!(AASRXCN>9)!(AASRXCN>1&(AASRXCN<7)) S AASRXCN=9
- S AASRXSEQ=$P(AAS1655("N3"),U,7) I AASRXSEQ=""!(AASRXSEQ<0)!(AASRXSEQ>6)!(AASRXSEQ=1) S AASRXSEQ=9
- S AASRDSB=$$AASDC^ONCOANC4($P(AAS1655("N5"),U))
- S ^TMP($J,D0,299)=^TMP($J,D0,299)_AASRTR_AASRDSR_AASRDRA_AASRDCH_AASRDHO_AASRDBR_AASRDOT
- D FOLLOW^ONCOANC3
- AASFLUP ; FOLLOW UP
- S AASDTLC=$$AASDC^ONCOANC4($P(AAS160("NF"),U))
- S ^TMP($J,D0,425)=^TMP($J,D0,425)_$E(AASBLNK,1,20)_AASDTLC
- S AASVSTA=$S($G(AASDTLC):$P(AAS160("NF"),U,2),1:" ") S:AASVSTA=""!(AASVSTA<0)!(AASVSTA>1) AASVSTA=1
- S AASCSTA=$S($G(AASDTLC):$P(AAS1655("N7"),U,6),1:" ") S AASCSTA=$S((AASCSTA="")!(AASCSTA<0)!(AASCSTA>5):9,(AASCSTA=4)!(AASCSTA=5):2,1:AASCSTA)
- S AASQS=$S($G(AASDTLC):$P(AAS160("NF"),U,5),1:" ") S:AASQS=""!(AASQS<0)!(AASQS>9)!(AASQS>4&(AASQS<8)) AASQS=9
- S AASROT=$P(AAS1655("N5"),U,2) I AASROT=""!(AASROT<0)!(AASROT>4) S AASROT=9
- S AASFSIT=$P(AAS1655("N5"),U,3) I AASFSIT=""!(AASFSIT<0)!(AASFSIT>9) S AASFSIT=9
- S:$L(AASFSIT)<3 AASFSIT=AASFSIT_$E(AASBLNK,1,3-$L(AASFSIT))
- ASSD ; CAUSE OF DEATH
- S AASCOD=$P(AAS160("N1"),U,3) S AASCOD=$S(AASCOD'="":$$GET1^DIQ(80,AASCOD,.01,"I"),1:"0000")
- I AASCOD["." S AASCOD=$P(AASCOD,".")_$P(AASCOD,".",2)
- S:$L(AASCOD)=3 AASCOD=AASCOD_9
- S:$L(AASCOD)<4 AASCOD=$E(AASZERO,1,4-$L(AASCOD))_AASCOD
- S:$L(AASCOD)>4 AASCOD=$E(AASCOD,1,4)
- I $E(AASCOD,4)="X"!($E(AASCOD,4)="-") S AASCOD=$E(AASCOD,1,3)_9
- S AASICDR=$S(AASCOD="0000":0,1:$P(AAS160("N1"),U,4))
- S:AASICDR="" AASICDR=0
- S ^TMP($J,D0,477)=AASVSTA_AASCSTA_AASQS_$E(AASBLNK,1,32)_AASRDSB_AASROT_AASFSIT_AASCOD_AASICDR
- S AASACDS=5
- S AASVNAM="VETAFFAIRS" ; vendor name
- S AASRVER=1 ; AACCR record version
- S ^TMP($J,D0,550)=$E(AASBLNK,1,45)_AASACDS_$E(AASBLNK,1,2)_AASVNAM_AASRVER_" "
- D ^ONCOANC5
- S MLHIX=MLHIX+1
- I $G(ONCOREP)=1 D TPREP^ONCOANC2,CU1P^ONCOANC9 Q
- I $G(ONCOREQ)=1 D REQREP^ONCOANC2,CU1P^ONCOANC9 Q
- F INDEX=76,149,225,299,352,425,477,550,628,706,784,850,925,1000 Q:AASTYPNC="I"&(INDEX>550) W ^TMP($J,D0,INDEX),"^",!
- I AASTYPNC="A" F INDEX=1075:75:4675 W ^TMP($J,D0,INDEX),"^",!
- W !!!
- D CU1P^ONCOANC9 ;K ^TMP($J)
- Q ;G AASRETN^ONCOANC0
- ;
- MLHTEST S X="" F I=76,149,225,299,352 S X=X_^TMP($J,D0,I)
- Q ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOANC1 4819 printed Feb 18, 2025@23:50:50 Page 2
- ONCOANC1 ;Hines OIFO/GWB - CONTINUE ONCOANC2 ;05/03/12
- +1 ;;2.2;ONCOLOGY;**1,7**;Jul 31, 2013;Build 5
- +2 ;rvd - 05/03/12 p56. Use ICD API (#3990) instead of direct global read.
- +3 ;
- AASTEOD ; STAGE/EXTENT OF DISEASE
- +1 SET AASEODS=$PIECE(AAS1655("N2"),U,17)
- SET AASEODS=$SELECT(AASEODS="":9,AASEODS<0:9,AASEODS>9:9,AASEODS=8:9,1:AASEODS)
- +2 SET AASEODT=$PIECE(AAS1655("N2"),U,9)
- SET AASEODT=$SELECT(AASEODT="":999,AASEODT[".":999,AASEODT<0:999,AASEODT>999:999,1:AASEODT)
- +3 if $LENGTH(AASEODT)<3
- SET AASEODT=$EXTRACT(AASZERO,1,3-$LENGTH(AASEODT))_AASEODT
- +4 SET AASEODE=$PIECE(AAS1655("N2"),U,10)
- SET AASEODE=$SELECT(AASEODE="":" ",AASEODE<0:" ",AASEODE>99:" ",1:AASEODE)
- +5 if $LENGTH(AASEODE)<2
- SET AASEODE=$EXTRACT(AASZERO,1,2-$LENGTH(AASEODE))_AASEODE
- +6 SET AASEODL=$PIECE(AAS1655("N2"),U,11)
- SET AASEODL=$SELECT(AASEODL="":" ",AASEODL<0:" ",AASEODL>9:" ",1:AASEODL)
- +7 SET AASNP=$PIECE(AAS1655("N2"),U,12)
- SET AASNP=$SELECT(AASNP="":99,AASNP[".":99,AASNP<0:99,AASNP>99:99,1:AASNP)
- +8 if $LENGTH(AASNP)<2
- SET AASNP=$EXTRACT(AASZERO,1,2-$LENGTH(AASNP))_AASNP
- +9 SET AASNE=$PIECE(AAS1655("N2"),U,13)
- SET AASNE=$SELECT(AASNE="":99,AASNE[".":99,AASNE<0:99,AASNE>99:99,1:AASNE)
- +10 if $LENGTH(AASNE)<2
- SET AASNE=$EXTRACT(AASZERO,1,2-$LENGTH(AASNE))_AASNE
- +11 ;(AASTNME=2
- SET AASTNME=$$EDT^ONCOANC3($EXTRACT(AASDXDT,7,8))
- +12 NEW AASTC,AASNC,AASMC,AASAJSM,AASTC2,AASNC2,AASMC2,AASJSM2
- +13 DO TNM^ONCOANC3(.AASTC,.AASNC,.AASMC,.AASAJSM,.AASTC2,.AASNC2,.AASMC2,.AASJSM2)
- +14 SET AASITME=$$MET^ONCOANC3(AAS1655("N2"))
- +15 if $LENGTH(AASITME)<3
- SET AASITME=AASITME_$EXTRACT(AASBLNK,1,3-$LENGTH(AASITME))
- +16 SET AASRT=$PIECE(AAS1655("N3"),U,28)
- SET AASRT=$SELECT(AASRT="":" ",AASRT<0:" ",AASRT>9:" ",1:AASRT)
- +17 IF AASRT>2&(AASRT<9)
- SET AASRT=" "
- +18 SET AASTM1=$PIECE(AAS1655("N24"),U,2)
- SET AASTM1=$SELECT(AASTM1="":" ",1:$PIECE(^ONCO(164.15,AASTM1,0),U))
- +19 SET AASTM2=$PIECE(AAS1655("N24"),U,3)
- SET AASTM2=$SELECT(AASTM2="":" ",1:$PIECE(^ONCO(164.15,AASTM2,0),U))
- +20 SET ^TMP($JOB,D0,225)=^TMP($JOB,D0,225)_AASEODS_" "_AASEODT_AASEODE_AASEODL_AASNP_AASNE_$EXTRACT(AASBLNK,1,19)_AASTC_AASNC_AASMC_AASAJSM_AASTC2_AASNC2_AASMC2_AASJSM2
- +21 SET ^TMP($JOB,D0,299)=AASTNME_AASITME_AASRT_$EXTRACT(AASBLNK,1,4)_AASTM1_AASTM2_$EXTRACT(AASBLNK,1,12)
- AASRXTR ; TREATMENT(RX)-ENTIRE(SUMMARY) FIRST COURSE
- +1 SET AASRTR=1
- +2 SET AASRDSR=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U))
- +3 SET AASRDRA=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U,4))
- +4 SET AASRDCH=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U,11))
- +5 SET AASRDHO=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U,14))
- +6 SET AASRDBR=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U,17))
- +7 SET AASRDOT=$$AASDC^ONCOANC4($PIECE(AAS1655("N3"),U,23))
- +8 SET AASX=$ORDER(^ONCO(165.5,"ATX",D0,0))
- if AASX'=""
- SET AASX=$EXTRACT(AASX,1,7)
- +9 SET AASRXBDT=$$AASDC^ONCOANC4(AASX,"ZERO")
- +10 SET AASRXREA=$PIECE(AAS1655("N3"),U,26)
- IF AASRXREA=""!(AASRXREA<0)!(AASRXREA>9)!(AASRXREA>2&(AASRXREA<6))
- SET AASRXREA=9
- +11 SET AASRXCN=$PIECE(AAS1655("N3"),U,10)
- IF AASRXCN=""!(AASRXCN<0)!(AASRXCN>9)!(AASRXCN>1&(AASRXCN<7))
- SET AASRXCN=9
- +12 SET AASRXSEQ=$PIECE(AAS1655("N3"),U,7)
- IF AASRXSEQ=""!(AASRXSEQ<0)!(AASRXSEQ>6)!(AASRXSEQ=1)
- SET AASRXSEQ=9
- +13 SET AASRDSB=$$AASDC^ONCOANC4($PIECE(AAS1655("N5"),U))
- +14 SET ^TMP($JOB,D0,299)=^TMP($JOB,D0,299)_AASRTR_AASRDSR_AASRDRA_AASRDCH_AASRDHO_AASRDBR_AASRDOT
- +15 DO FOLLOW^ONCOANC3
- AASFLUP ; FOLLOW UP
- +1 SET AASDTLC=$$AASDC^ONCOANC4($PIECE(AAS160("NF"),U))
- +2 SET ^TMP($JOB,D0,425)=^TMP($JOB,D0,425)_$EXTRACT(AASBLNK,1,20)_AASDTLC
- +3 SET AASVSTA=$SELECT($GET(AASDTLC):$PIECE(AAS160("NF"),U,2),1:" ")
- if AASVSTA=""!(AASVSTA<0)!(AASVSTA>1)
- SET AASVSTA=1
- +4 SET AASCSTA=$SELECT($GET(AASDTLC):$PIECE(AAS1655("N7"),U,6),1:" ")
- SET AASCSTA=$SELECT((AASCSTA="")!(AASCSTA<0)!(AASCSTA>5):9,(AASCSTA=4)!(AASCSTA=5):2,1:AASCSTA)
- +5 SET AASQS=$SELECT($GET(AASDTLC):$PIECE(AAS160("NF"),U,5),1:" ")
- if AASQS=""!(AASQS<0)!(AASQS>9)!(AASQS>4&(AASQS<8))
- SET AASQS=9
- +6 SET AASROT=$PIECE(AAS1655("N5"),U,2)
- IF AASROT=""!(AASROT<0)!(AASROT>4)
- SET AASROT=9
- +7 SET AASFSIT=$PIECE(AAS1655("N5"),U,3)
- IF AASFSIT=""!(AASFSIT<0)!(AASFSIT>9)
- SET AASFSIT=9
- +8 if $LENGTH(AASFSIT)<3
- SET AASFSIT=AASFSIT_$EXTRACT(AASBLNK,1,3-$LENGTH(AASFSIT))
- ASSD ; CAUSE OF DEATH
- +1 SET AASCOD=$PIECE(AAS160("N1"),U,3)
- SET AASCOD=$SELECT(AASCOD'="":$$GET1^DIQ(80,AASCOD,.01,"I"),1:"0000")
- +2 IF AASCOD["."
- SET AASCOD=$PIECE(AASCOD,".")_$PIECE(AASCOD,".",2)
- +3 if $LENGTH(AASCOD)=3
- SET AASCOD=AASCOD_9
- +4 if $LENGTH(AASCOD)<4
- SET AASCOD=$EXTRACT(AASZERO,1,4-$LENGTH(AASCOD))_AASCOD
- +5 if $LENGTH(AASCOD)>4
- SET AASCOD=$EXTRACT(AASCOD,1,4)
- +6 IF $EXTRACT(AASCOD,4)="X"!($EXTRACT(AASCOD,4)="-")
- SET AASCOD=$EXTRACT(AASCOD,1,3)_9
- +7 SET AASICDR=$SELECT(AASCOD="0000":0,1:$PIECE(AAS160("N1"),U,4))
- +8 if AASICDR=""
- SET AASICDR=0
- +9 SET ^TMP($JOB,D0,477)=AASVSTA_AASCSTA_AASQS_$EXTRACT(AASBLNK,1,32)_AASRDSB_AASROT_AASFSIT_AASCOD_AASICDR
- +10 SET AASACDS=5
- +11 ; vendor name
- SET AASVNAM="VETAFFAIRS"
- +12 ; AACCR record version
- SET AASRVER=1
- +13 SET ^TMP($JOB,D0,550)=$EXTRACT(AASBLNK,1,45)_AASACDS_$EXTRACT(AASBLNK,1,2)_AASVNAM_AASRVER_" "
- +14 DO ^ONCOANC5
- +15 SET MLHIX=MLHIX+1
- +16 IF $GET(ONCOREP)=1
- DO TPREP^ONCOANC2
- DO CU1P^ONCOANC9
- QUIT
- +17 IF $GET(ONCOREQ)=1
- DO REQREP^ONCOANC2
- DO CU1P^ONCOANC9
- QUIT
- +18 FOR INDEX=76,149,225,299,352,425,477,550,628,706,784,850,925,1000
- if AASTYPNC="I"&(INDEX>550)
- QUIT
- WRITE ^TMP($JOB,D0,INDEX),"^",!
- +19 IF AASTYPNC="A"
- FOR INDEX=1075:75:4675
- WRITE ^TMP($JOB,D0,INDEX),"^",!
- +20 WRITE !!!
- +21 ;K ^TMP($J)
- DO CU1P^ONCOANC9
- +22 ;G AASRETN^ONCOANC0
- QUIT
- +23 ;
- MLHTEST SET X=""
- FOR I=76,149,225,299,352
- SET X=X_^TMP($JOB,D0,I)
- +1 ;
- QUIT