- ONCOANC3 ;Hines OIFO/GWB - CONTINUE ONCOANC2 ;12/23/94
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- ;
- TNM(PTCODE,PNCODE,PMCODE,PGROUP,CTCODE,CNCODE,CMCODE,CGROUP) ; STAGE/EXTENT OF DISEASE
- N TCODE,NCODE,MCODE,GROUP,BASIS
- CLIN S TCODE=$P(AAS1655("N2"),U,25) S TCODE=$S(TCODE="":" ",TCODE'?.2NA:" ",$L(TCODE)<2:TCODE_$E(AASBLNK,1,2-$L(TCODE)),1:TCODE),CTCODE=TCODE
- S NCODE=$P(AAS1655("N2"),U,26) S NCODE=$S(NCODE="":" ",NCODE'?.2NA:" ",$L(NCODE)<2:NCODE_$E(AASBLNK,1,2-$L(NCODE)),1:NCODE),CNCODE=NCODE
- S MCODE=$P(AAS1655("N2"),U,27) S MCODE=$S(MCODE="":" ",MCODE'?.1NA:" ",1:MCODE),CMCODE=MCODE
- S GROUP=$P(AAS1655("N2"),U,20) S GROUP=$S(GROUP="":" ",GROUP'?.2NA:" ",1:GROUP)
- S GROUP=$S("^0^0A^1^1A^1B^1C^2^2A^2B^2C^3^3A^3B^3C^4^4A^4B^4C^9^"[("^"_GROUP_"^"):GROUP,GROUP["0":"0",1:"9") ; S GROUP=" "
- S:$L(GROUP)<2 GROUP=GROUP_$E(AASBLNK,1,2-$L(GROUP))
- S CGROUP=GROUP
- PATH S TCODE=$P($G(^ONCO(165.5,D0,2.1)),U,1)
- S TCODE=$S(TCODE="":" ",TCODE'?.2NA:" ",$L(TCODE)<2:TCODE_$E(AASBLNK,1,2-$L(TCODE)),1:TCODE)
- S PTCODE=TCODE
- S NCODE=$P($G(^ONCO(165.5,D0,2.1)),U,2)
- S NCODE=$S(NCODE="":" ",NCODE'?.2NA:" ",$L(NCODE)<2:NCODE_$E(AASBLNK,1,2-$L(NCODE)),1:NCODE)
- S PNCODE=NCODE
- S MCODE=$P($G(^ONCO(165.5,D0,2.1)),U,3)
- S MCODE=$S(MCODE="":" ",MCODE'?.1NA:" ",1:MCODE),PMCODE=MCODE
- S GROUP=$P($G(^ONCO(165.5,D0,2.1)),U,4)
- S GROUP=$S(GROUP="":" ",GROUP'?.2NA:" ",1:GROUP)
- S GROUP=$S("^0^0A^1^1A^1B^1C^2^2A^2B^2C^3^3A^3B^3C^4^4A^4B^4C^9^"[("^"_GROUP_"^"):GROUP,GROUP["0":"0",1:"9")
- S:$L(GROUP)<2 GROUP=GROUP_$E(AASBLNK,1,2-$L(GROUP))
- S PGROUP=GROUP
- Q
- FOLLOW ;
- D INIT^ONCOANC4(D0,.AASRDSB1,.AASRHSR1,.AASRHRA1,.AASRXCH1,.AASRST1,.AASRXBR1,.AASROC1,1)
- S ^TMP($J,D0,352)=AASRXBDT_AASRHSR_AASRXREA_AASRHRA_AASRXCN_AASRXSEQ_AASRXCH_AASRST_AASRXBR_AASROC_$E(AASBLNK,1,20)_AASRDSB1_AASRHSR1_AASRHRA1_AASRXCH1_AASRST1_AASRXBR1_AASROC1
- D INIT^ONCOANC4(D0,.AASRDSB2,.AASRHSR2,.AASRHRA2,.AASRXCH2,.AASRST2,.AASRXBR2,.AASROC2,2)
- S ^TMP($J,D0,425)=AASRDSB2_AASRHSR2_AASRHRA2_AASRXCH2_AASRST2_AASRXBR2_AASROC2
- D INIT^ONCOANC4(D0,.AASRDSB3,.AASRHSR3,.AASRHRA3,.AASRXCH3,.AASRST3,.AASRXBR3,.AASROC3,3)
- S ^TMP($J,D0,425)=^TMP($J,D0,425)_AASRDSB3_AASRHSR3_AASRHRA3_AASRXCH3_AASRST3_AASRXBR3_AASROC3
- D INIT^ONCOANC4(D0,.AASRDSB4,.AASRHSR4,.AASRHRA4,.AASRXCH4,.AASRST4,.AASRXBR4,.AASROC4,4)
- S ^TMP($J,D0,425)=^TMP($J,D0,425)_AASRDSB4_AASRHSR4_AASRHRA4_AASRXCH4_AASRST4_AASRXBR4_AASROC4
- Q
- HANG ;
- W !!
- S DIR("T")=30 ; timeout override
- S DIR("A",1)="I will hang for "_DIR("T")_" seconds while you set up the log file."
- S DIR("A")="(Hit <CR> to start sooner, or enter '^' to abort)"
- S DIR(0)="E" D ^DIR K DIR
- Q
- EDT(DOD) ;
- N CNT,OSP S CNT=0
- S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
- I OSP="" S OSP=$O(^ONCO(160.1,0))
- S CNT=$P($G(^ONCO(160.1,OSP,5)),U,1)
- Q $S(DOD<88:2,DOD<+CNT:3,DOD<93:3,1:4)
- MET(NODE) ;
- N PIECE,VALUE S VALUE=""
- F PIECE=14,15,16 D
- .S VALUE=VALUE_$S($L($P(NODE,U,PIECE)):$P(NODE,U,PIECE),1:0)
- Q VALUE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOANC3 2982 printed Feb 18, 2025@23:50:52 Page 2
- ONCOANC3 ;Hines OIFO/GWB - CONTINUE ONCOANC2 ;12/23/94
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 ;
- TNM(PTCODE,PNCODE,PMCODE,PGROUP,CTCODE,CNCODE,CMCODE,CGROUP) ; STAGE/EXTENT OF DISEASE
- +1 NEW TCODE,NCODE,MCODE,GROUP,BASIS
- CLIN SET TCODE=$PIECE(AAS1655("N2"),U,25)
- SET TCODE=$SELECT(TCODE="":" ",TCODE'?.2NA:" ",$LENGTH(TCODE)<2:TCODE_$EXTRACT(AASBLNK,1,2-$LENGTH(TCODE)),1:TCODE)
- SET CTCODE=TCODE
- +1 SET NCODE=$PIECE(AAS1655("N2"),U,26)
- SET NCODE=$SELECT(NCODE="":" ",NCODE'?.2NA:" ",$LENGTH(NCODE)<2:NCODE_$EXTRACT(AASBLNK,1,2-$LENGTH(NCODE)),1:NCODE)
- SET CNCODE=NCODE
- +2 SET MCODE=$PIECE(AAS1655("N2"),U,27)
- SET MCODE=$SELECT(MCODE="":" ",MCODE'?.1NA:" ",1:MCODE)
- SET CMCODE=MCODE
- +3 SET GROUP=$PIECE(AAS1655("N2"),U,20)
- SET GROUP=$SELECT(GROUP="":" ",GROUP'?.2NA:" ",1:GROUP)
- +4 ; S GROUP=" "
- SET GROUP=$SELECT("^0^0A^1^1A^1B^1C^2^2A^2B^2C^3^3A^3B^3C^4^4A^4B^4C^9^"[("^"_GROUP_"^"):GROUP,GROUP["0":"0",1:"9")
- +5 if $LENGTH(GROUP)<2
- SET GROUP=GROUP_$EXTRACT(AASBLNK,1,2-$LENGTH(GROUP))
- +6 SET CGROUP=GROUP
- PATH SET TCODE=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,1)
- +1 SET TCODE=$SELECT(TCODE="":" ",TCODE'?.2NA:" ",$LENGTH(TCODE)<2:TCODE_$EXTRACT(AASBLNK,1,2-$LENGTH(TCODE)),1:TCODE)
- +2 SET PTCODE=TCODE
- +3 SET NCODE=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,2)
- +4 SET NCODE=$SELECT(NCODE="":" ",NCODE'?.2NA:" ",$LENGTH(NCODE)<2:NCODE_$EXTRACT(AASBLNK,1,2-$LENGTH(NCODE)),1:NCODE)
- +5 SET PNCODE=NCODE
- +6 SET MCODE=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,3)
- +7 SET MCODE=$SELECT(MCODE="":" ",MCODE'?.1NA:" ",1:MCODE)
- SET PMCODE=MCODE
- +8 SET GROUP=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,4)
- +9 SET GROUP=$SELECT(GROUP="":" ",GROUP'?.2NA:" ",1:GROUP)
- +10 SET GROUP=$SELECT("^0^0A^1^1A^1B^1C^2^2A^2B^2C^3^3A^3B^3C^4^4A^4B^4C^9^"[("^"_GROUP_"^"):GROUP,GROUP["0":"0",1:"9")
- +11 if $LENGTH(GROUP)<2
- SET GROUP=GROUP_$EXTRACT(AASBLNK,1,2-$LENGTH(GROUP))
- +12 SET PGROUP=GROUP
- +13 QUIT
- FOLLOW ;
- +1 DO INIT^ONCOANC4(D0,.AASRDSB1,.AASRHSR1,.AASRHRA1,.AASRXCH1,.AASRST1,.AASRXBR1,.AASROC1,1)
- +2 SET ^TMP($JOB,D0,352)=AASRXBDT_AASRHSR_AASRXREA_AASRHRA_AASRXCN_AASRXSEQ_AASRXCH_AASRST_AASRXBR_AASROC_$EXTRACT(AASBLNK,1,20)_AASRDSB1_AASRHSR1_AASRHRA1_AASRXCH1_AASRST1_AASRXBR1_AASROC1
- +3 DO INIT^ONCOANC4(D0,.AASRDSB2,.AASRHSR2,.AASRHRA2,.AASRXCH2,.AASRST2,.AASRXBR2,.AASROC2,2)
- +4 SET ^TMP($JOB,D0,425)=AASRDSB2_AASRHSR2_AASRHRA2_AASRXCH2_AASRST2_AASRXBR2_AASROC2
- +5 DO INIT^ONCOANC4(D0,.AASRDSB3,.AASRHSR3,.AASRHRA3,.AASRXCH3,.AASRST3,.AASRXBR3,.AASROC3,3)
- +6 SET ^TMP($JOB,D0,425)=^TMP($JOB,D0,425)_AASRDSB3_AASRHSR3_AASRHRA3_AASRXCH3_AASRST3_AASRXBR3_AASROC3
- +7 DO INIT^ONCOANC4(D0,.AASRDSB4,.AASRHSR4,.AASRHRA4,.AASRXCH4,.AASRST4,.AASRXBR4,.AASROC4,4)
- +8 SET ^TMP($JOB,D0,425)=^TMP($JOB,D0,425)_AASRDSB4_AASRHSR4_AASRHRA4_AASRXCH4_AASRST4_AASRXBR4_AASROC4
- +9 QUIT
- HANG ;
- +1 WRITE !!
- +2 ; timeout override
- SET DIR("T")=30
- +3 SET DIR("A",1)="I will hang for "_DIR("T")_" seconds while you set up the log file."
- +4 SET DIR("A")="(Hit <CR> to start sooner, or enter '^' to abort)"
- +5 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +6 QUIT
- EDT(DOD) ;
- +1 NEW CNT,OSP
- SET CNT=0
- +2 SET OSP=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
- +3 IF OSP=""
- SET OSP=$ORDER(^ONCO(160.1,0))
- +4 SET CNT=$PIECE($GET(^ONCO(160.1,OSP,5)),U,1)
- +5 QUIT $SELECT(DOD<88:2,DOD<+CNT:3,DOD<93:3,1:4)
- MET(NODE) ;
- +1 NEW PIECE,VALUE
- SET VALUE=""
- +2 FOR PIECE=14,15,16
- Begin DoDot:1
- +3 SET VALUE=VALUE_$SELECT($LENGTH($PIECE(NODE,U,PIECE)):$PIECE(NODE,U,PIECE),1:0)
- End DoDot:1
- +4 QUIT VALUE