- ONCOTNM2 ;Hines OIFO/RTK - TNM Codes input transform & help ;9/29/16 15:38
- ;;2.2;ONCOLOGY;**6**;Jul 31, 2013;Build 10
- ;
- ;New input transform and help -- NAACCR Vol II V16
- ; This will replace all the codes specific to Topography & Histology
- ;
- ; make sure case is correct
- INPUT ;
- S DATEDX=$P($G(^ONCO(165.5,D0,0)),"^",16)
- S X=$TR(X,"abcdilmopsuvx","ABCDILMOPSUVX")
- I $E(X)="C" S X="c"_$E(X,2,8) W " ",X
- I $E(X)="P" S X="p"_$E(X,2,8) W " ",X
- I ONCOX="T",STGIND="C" D TCLIN Q
- I ONCOX="N",STGIND="C" D NCLIN Q
- I ONCOX="M",STGIND="C" D MCLIN Q
- I ONCOX="T",STGIND="P" D TPATH Q
- I ONCOX="N",STGIND="P" D NPATH Q
- I ONCOX="M",STGIND="P" D MPATH Q
- Q
- ;
- TCLIN ;
- I X="cX"!(X="c0")!(X="pA")!(X="pIS")!(X="pISU")!(X="pISD") Q
- I X="c1MI"!(X="c1")!(X="c1A")!(X="c1A1")!(X="c1A2")!(X="c1B") Q
- I X="c1B1"!(X="c1B2")!(X="c1C")!(X="c1D")!(X="c2")!(X="c2A") Q
- I X="c2A1"!(X="c2A2")!(X="c2B")!(X="c2C")!(X="c2D")!(X="c3") Q
- I X="c3A"!(X="c3B")!(X="c3C")!(X="c3D")!(X="c4")!(X="c4A") Q
- I X="c4B"!(X="c4C")!(X="c4D")!(X="c4E")!(X=88) Q
- K X Q
- ;
- NCLIN ;
- I X="cX"!(X="c0")!(X="c0A")!(X="c0B")!(X="c1")!(X="c1A") Q
- I X="c1B"!(X="c1C")!(X="c2")!(X="c2A")!(X="c2B")!(X="c2C") Q
- I X="c3"!(X="c3A")!(X="c3B")!(X="c3C")!(X="c4")!(X=88) Q
- K X Q
- ;
- MCLIN ;
- I X="c0"!(X="c0I+")!(X="c1")!(X="c1A")!(X="c1B") Q
- I X="c1C"!(X="c1D")!(X="c1E")!(X="p1")!(X="p1A") Q
- I X="p1B"!(X="p1C")!(X="p1D")!(X="p1E")!(X=88) Q
- I DATEDX<3100101,X="cX" Q
- K X Q
- ;
- TPATH ;
- I X="pX"!(X="p0")!(X="pA")!(X="pIS")!(X="pISU")!(X="pISD") Q
- I X="p1MI"!(X="p1")!(X="p1A")!(X="p1A1")!(X="p1A2")!(X="p1B") Q
- I X="p1B1"!(X="p1B2")!(X="p1C")!(X="p1D")!(X="p2")!(X="p2A") Q
- I X="p2A1"!(X="p2A2")!(X="p2B")!(X="p2C")!(X="p2D")!(X="p3") Q
- I X="p3A"!(X="p3B")!(X="p3C")!(X="p3D")!(X="p4")!(X="p4A") Q
- I X="p4B"!(X="p4C")!(X="p4D")!(X="p4E")!(X=88) Q
- K X Q
- ;
- NPATH ;
- I X="pX"!(X="c0")!(X="p0")!(X="p0I-")!(X="p0I+")!(X="p0M-") Q
- I X="p0M+"!(X="p1MI")!(X="p0A")!(X="p0B")!(X="p1")!(X="p1A") Q
- I X="p1B"!(X="p1C")!(X="p2")!(X="p2A")!(X="p2B") Q
- I X="p2C"!(X="p3")!(X="p3A")!(X="p3B")!(X="p3C")!(X="p4")!(X=88) Q
- I DATEDX<3020101,(X="p1BI")!(X="p1BII")!(X="p1BIII")!(X="p1BIV") Q
- K X Q
- ;
- MPATH ;
- I X="c0"!(X="c0I+")!(X="p1")!(X="p1A")!(X="p1B") Q
- I X="p1C"!(X="p1D")!(X="p1E")!(X="c1")!(X="c1A") Q
- I X="c1B"!(X="c1C")!(X="c1D")!(X="c1E")!(X=88) Q
- I DATEDX<3100101,X="pX" Q
- K X Q
- ;
- HELP ;
- S DATEDX=$P($G(^ONCO(165.5,D0,0)),"^",16)
- I ONCOX="T",STGIND="C" D TCLINHP Q
- I ONCOX="N",STGIND="C" D NCLINHP Q
- I ONCOX="M",STGIND="C" D MCLINHP Q
- I ONCOX="T",STGIND="P" D TPATHHP Q
- I ONCOX="N",STGIND="P" D NPATHHP Q
- I ONCOX="M",STGIND="P" D MPATHHP Q
- Q
- TCLINHP ;
- W !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL T"
- W !?8,"cX",?16,"c0",?24,"pA",?32,"pIS",?40,"pISU",?48,"pISD",?56,"c1MI"
- W !?8,"c1",?16,"c1A",?24,"c1A1",?32,"c1A2",?40,"c1B",?48,"c1B1",?56,"c1B2"
- W !?8,"c1C",?16,"c1D",?24,"c2",?32,"c2A",?40,"c2A1",?48,"c2A2",?56,"c2B"
- W !?8,"c2C",?16,"c2D",?24,"c3",?32,"c3A",?40,"c3B",?48,"c3C",?56,"c3D"
- W !?8,"c4",?16,"c4A",?24,"c4B",?32,"c4C",?40,"c4D",?48,"c4E",?56,88,!
- Q
- NCLINHP ;
- W !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL N"
- W !?8,"cX",?16,"c0",?24,"c0A",?32,"c0B",?40,"c1",?48,"c1A"
- W !?8,"c1B",?16,"c1C",?24,"c2",?32,"c2A",?40,"c2B",?48,"c2C"
- W !?8,"c3",?16,"c3A",?24,"c3B",?32,"c3C",?40,"c4",?48,88,!
- Q
- MCLINHP ;
- W !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL M"
- W !?8,"c0",?16,"c0I+",?24,"c1",?32,"c1A",?40,"c1B"
- W !?8,"c1C",?16,"c1D",?24,"c1E",?32,"p1",?40,"p1A"
- W !?8,"p1B",?16,"p1C",?24,"p1D",?32,"p1E",?40,88
- I DATEDX<3100101 W ?48,"cX"
- W ! Q
- TPATHHP ;
- W !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR PATHOLOGIC T"
- W !?8,"pX",?16,"p0",?24,"pA",?32,"pIS",?40,"pISU",?48,"pISD"
- W !?8,"p1MI",?16,"p1",?24,"p1A",?32,"p1A1",?40,"p1A2",?48,"p1B"
- W !?8,"p1B1",?16,"p1B2",?24,"p1C",?32,"p1D",?40,"p2",?48,"p2A"
- W !?8,"p2A1",?16,"p2A2",?24,"p2B",?32,"p2C",?40,"p2D",?48,"p3"
- W !?8,"p3A",?16,"p3B",?24,"p3C",?32,"p3D",?40,"p4",?48,"p4A"
- W !?8,"p4B",?16,"p4C",?24,"p4D",?32,"p4E",?40,88,!
- Q
- NPATHHP ;
- W !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR PATHOLOGIC N"
- W !?8,"pX",?16,"c0",?24,"p0",?32,"p0I-",?40,"p0I+"
- W !?8,"p0M-",?16,"p0M+",?24,"p1MI",?32,"p0A",?40,"p0B"
- W !?8,"p1",?16,"p1A",?24,"p1B",?32,"p1C",?40,"p2"
- W !?8,"p2A",?16,"p2B",?24,"p2C",?32,"p3",?40,"p3A"
- W !?8,"p3B",?16,"p3C",?24,"p4",?32,88
- I DATEDX<3020101 W !?8,"p1BI",?16,"p1BII",?24,"p1BIII",?32,"p1BIV"
- W ! Q
- MPATHHP ;
- W !?8,"c0",?16,"c0I+",?24,"p1",?32,"p1A",?40,"p1B"
- W !?8,"p1C",?16,"p1D",?24,"p1E",?32,"c1",?40,"c1A"
- W !?8,"c1B",?16,"c1C",?24,"c1D",?32,"c1E",?40,88
- I DATEDX<3100101 W ?48,"pX"
- W ! Q
- ;
- VALID ;check the validity of the Clinical and Pathologic TNM data values
- ; after the Patch 6 converion for NAACCR Vol II v16
- N X,EX K ^TMP($J,"ONCINV") S NN=0,EX=""
- ;loop through and check if any of the 6 TNM fields have bad data
- F IEN=0:0 S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 D
- .S DATEDX=$P($G(^ONCO(165.5,IEN,0)),"^",16)
- .S CLINT=$P($G(^ONCO(165.5,IEN,2)),U,25) S X=CLINT I X=""!(X=88) Q
- .D TCLIN I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"CLINICAL T")=ZZACSQ_U_CLINT
- .S CLINN=$P($G(^ONCO(165.5,IEN,2)),U,26) S X=CLINN I X=""!(X=88) Q
- .D NCLIN I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"CLINICAL N")=ZZACSQ_U_CLINN
- .S CLINM=$P($G(^ONCO(165.5,IEN,2)),U,27) S X=CLINM I X=""!(X=88) Q
- .D MCLIN I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"CLINICAL M")=ZZACSQ_U_CLINM
- .S PATHT=$P($G(^ONCO(165.5,IEN,2.1)),U,1) S X=PATHT I X=""!(X=88) Q
- .D TPATH I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC T")=ZZACSQ_U_PATHT
- .S PATHN=$P($G(^ONCO(165.5,IEN,2.1)),U,2) S X=PATHN I X=""!(X=88) Q
- .D NPATH I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC N")=ZZACSQ_U_PATHN
- .S PATHM=$P($G(^ONCO(165.5,IEN,2.1)),U,3) S X=PATHM I X=""!(X=88) Q
- .D MPATH I '$D(X) D GETPTV S ^TMP($J,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC M")=ZZACSQ_U_PATHM
- W !
- ;display the invalid data, if any
- I '$D(^TMP($J,"ONCINV")) W !?3,"All Clinical and Pathologic TNM data is valid!",! K CLINT,CLINN,CLINM,PATHT,PATHN,PATHM,IEN,NN,TNMFLD,ZZ160,ZZVRPT,ZZPTNM,ZZACSQ,^TMP($J,"ONCINV") Q
- W @IOF,!!!,"Display list of patients with invalid data in"
- W !,"the Clinical or Pathologic TNM fields",!
- S ZZPTNM="" F S ZZPTNM=$O(^TMP($J,"ONCINV",ZZPTNM)) Q:ZZPTNM=""!(EX=U) D
- .F IEN=0:0 S IEN=$O(^TMP($J,"ONCINV",ZZPTNM,IEN)) Q:IEN'>0!(EX=U) D
- ..S NN=NN+1 W !!,"Patient Name: ",ZZPTNM
- ..S TNMFLD="" F S TNMFLD=$O(^TMP($J,"ONCINV",ZZPTNM,IEN,TNMFLD)) Q:TNMFLD=""!(EX=U) D
- ...W !," Acc/Seq #: ",$P(^TMP($J,"ONCINV",ZZPTNM,IEN,TNMFLD),"^",1)," ",TNMFLD," invalid value = ",$P(^TMP($J,"ONCINV",ZZPTNM,IEN,TNMFLD),"^",2)
- ...I $Y>(IOSL-4) D PG I EX=U Q
- ..Q
- .Q
- I EX'=U W !!?9,NN," total patient records with invalid TNM data...",! D PG I EX=U Q
- K CLINT,CLINN,CLINM,PATHT,PATHN,PATHM,IEN,NN,TNMFLD,ZZ160,ZZVRPT,ZZPTNM,ZZACSQ ;,^TMP($J,"ONCINV") Q
- Q
- ;
- GETPTV ;
- S ZZ160=$P($G(^ONCO(165.5,IEN,0)),"^",2)
- S ZZVRPT=$P($G(^ONCO(160,ZZ160,0)),"^",1)
- I ZZVRPT[";DPT" S ZZPTNM=$P($G(^DPT($P(ZZVRPT,";",1),0)),"^",1)
- I ZZVRPT[";LRT" S ZZPTNM=$P($G(^LRT(67,$P(ZZVRPT,";",1),0)),"^",1)
- S ZZACSQ=$E($P($G(^ONCO(165.5,IEN,0)),"^",5),1,4)_"-"_$E($P($G(^ONCO(165.5,IEN,0)),"^",5),5,9)_"/"_$P($G(^ONCO(165.5,IEN,0)),"^",6)
- Q
- ;
- PG ;
- I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
- W @IOF Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTNM2 7510 printed Feb 18, 2025@23:52:27 Page 2
- ONCOTNM2 ;Hines OIFO/RTK - TNM Codes input transform & help ;9/29/16 15:38
- +1 ;;2.2;ONCOLOGY;**6**;Jul 31, 2013;Build 10
- +2 ;
- +3 ;New input transform and help -- NAACCR Vol II V16
- +4 ; This will replace all the codes specific to Topography & Histology
- +5 ;
- +6 ; make sure case is correct
- INPUT ;
- +1 SET DATEDX=$PIECE($GET(^ONCO(165.5,D0,0)),"^",16)
- +2 SET X=$TRANSLATE(X,"abcdilmopsuvx","ABCDILMOPSUVX")
- +3 IF $EXTRACT(X)="C"
- SET X="c"_$EXTRACT(X,2,8)
- WRITE " ",X
- +4 IF $EXTRACT(X)="P"
- SET X="p"_$EXTRACT(X,2,8)
- WRITE " ",X
- +5 IF ONCOX="T"
- IF STGIND="C"
- DO TCLIN
- QUIT
- +6 IF ONCOX="N"
- IF STGIND="C"
- DO NCLIN
- QUIT
- +7 IF ONCOX="M"
- IF STGIND="C"
- DO MCLIN
- QUIT
- +8 IF ONCOX="T"
- IF STGIND="P"
- DO TPATH
- QUIT
- +9 IF ONCOX="N"
- IF STGIND="P"
- DO NPATH
- QUIT
- +10 IF ONCOX="M"
- IF STGIND="P"
- DO MPATH
- QUIT
- +11 QUIT
- +12 ;
- TCLIN ;
- +1 IF X="cX"!(X="c0")!(X="pA")!(X="pIS")!(X="pISU")!(X="pISD")
- QUIT
- +2 IF X="c1MI"!(X="c1")!(X="c1A")!(X="c1A1")!(X="c1A2")!(X="c1B")
- QUIT
- +3 IF X="c1B1"!(X="c1B2")!(X="c1C")!(X="c1D")!(X="c2")!(X="c2A")
- QUIT
- +4 IF X="c2A1"!(X="c2A2")!(X="c2B")!(X="c2C")!(X="c2D")!(X="c3")
- QUIT
- +5 IF X="c3A"!(X="c3B")!(X="c3C")!(X="c3D")!(X="c4")!(X="c4A")
- QUIT
- +6 IF X="c4B"!(X="c4C")!(X="c4D")!(X="c4E")!(X=88)
- QUIT
- +7 KILL X
- QUIT
- +8 ;
- NCLIN ;
- +1 IF X="cX"!(X="c0")!(X="c0A")!(X="c0B")!(X="c1")!(X="c1A")
- QUIT
- +2 IF X="c1B"!(X="c1C")!(X="c2")!(X="c2A")!(X="c2B")!(X="c2C")
- QUIT
- +3 IF X="c3"!(X="c3A")!(X="c3B")!(X="c3C")!(X="c4")!(X=88)
- QUIT
- +4 KILL X
- QUIT
- +5 ;
- MCLIN ;
- +1 IF X="c0"!(X="c0I+")!(X="c1")!(X="c1A")!(X="c1B")
- QUIT
- +2 IF X="c1C"!(X="c1D")!(X="c1E")!(X="p1")!(X="p1A")
- QUIT
- +3 IF X="p1B"!(X="p1C")!(X="p1D")!(X="p1E")!(X=88)
- QUIT
- +4 IF DATEDX<3100101
- IF X="cX"
- QUIT
- +5 KILL X
- QUIT
- +6 ;
- TPATH ;
- +1 IF X="pX"!(X="p0")!(X="pA")!(X="pIS")!(X="pISU")!(X="pISD")
- QUIT
- +2 IF X="p1MI"!(X="p1")!(X="p1A")!(X="p1A1")!(X="p1A2")!(X="p1B")
- QUIT
- +3 IF X="p1B1"!(X="p1B2")!(X="p1C")!(X="p1D")!(X="p2")!(X="p2A")
- QUIT
- +4 IF X="p2A1"!(X="p2A2")!(X="p2B")!(X="p2C")!(X="p2D")!(X="p3")
- QUIT
- +5 IF X="p3A"!(X="p3B")!(X="p3C")!(X="p3D")!(X="p4")!(X="p4A")
- QUIT
- +6 IF X="p4B"!(X="p4C")!(X="p4D")!(X="p4E")!(X=88)
- QUIT
- +7 KILL X
- QUIT
- +8 ;
- NPATH ;
- +1 IF X="pX"!(X="c0")!(X="p0")!(X="p0I-")!(X="p0I+")!(X="p0M-")
- QUIT
- +2 IF X="p0M+"!(X="p1MI")!(X="p0A")!(X="p0B")!(X="p1")!(X="p1A")
- QUIT
- +3 IF X="p1B"!(X="p1C")!(X="p2")!(X="p2A")!(X="p2B")
- QUIT
- +4 IF X="p2C"!(X="p3")!(X="p3A")!(X="p3B")!(X="p3C")!(X="p4")!(X=88)
- QUIT
- +5 IF DATEDX<3020101
- IF (X="p1BI")!(X="p1BII")!(X="p1BIII")!(X="p1BIV")
- QUIT
- +6 KILL X
- QUIT
- +7 ;
- MPATH ;
- +1 IF X="c0"!(X="c0I+")!(X="p1")!(X="p1A")!(X="p1B")
- QUIT
- +2 IF X="p1C"!(X="p1D")!(X="p1E")!(X="c1")!(X="c1A")
- QUIT
- +3 IF X="c1B"!(X="c1C")!(X="c1D")!(X="c1E")!(X=88)
- QUIT
- +4 IF DATEDX<3100101
- IF X="pX"
- QUIT
- +5 KILL X
- QUIT
- +6 ;
- HELP ;
- +1 SET DATEDX=$PIECE($GET(^ONCO(165.5,D0,0)),"^",16)
- +2 IF ONCOX="T"
- IF STGIND="C"
- DO TCLINHP
- QUIT
- +3 IF ONCOX="N"
- IF STGIND="C"
- DO NCLINHP
- QUIT
- +4 IF ONCOX="M"
- IF STGIND="C"
- DO MCLINHP
- QUIT
- +5 IF ONCOX="T"
- IF STGIND="P"
- DO TPATHHP
- QUIT
- +6 IF ONCOX="N"
- IF STGIND="P"
- DO NPATHHP
- QUIT
- +7 IF ONCOX="M"
- IF STGIND="P"
- DO MPATHHP
- QUIT
- +8 QUIT
- TCLINHP ;
- +1 WRITE !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL T"
- +2 WRITE !?8,"cX",?16,"c0",?24,"pA",?32,"pIS",?40,"pISU",?48,"pISD",?56,"c1MI"
- +3 WRITE !?8,"c1",?16,"c1A",?24,"c1A1",?32,"c1A2",?40,"c1B",?48,"c1B1",?56,"c1B2"
- +4 WRITE !?8,"c1C",?16,"c1D",?24,"c2",?32,"c2A",?40,"c2A1",?48,"c2A2",?56,"c2B"
- +5 WRITE !?8,"c2C",?16,"c2D",?24,"c3",?32,"c3A",?40,"c3B",?48,"c3C",?56,"c3D"
- +6 WRITE !?8,"c4",?16,"c4A",?24,"c4B",?32,"c4C",?40,"c4D",?48,"c4E",?56,88,!
- +7 QUIT
- NCLINHP ;
- +1 WRITE !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL N"
- +2 WRITE !?8,"cX",?16,"c0",?24,"c0A",?32,"c0B",?40,"c1",?48,"c1A"
- +3 WRITE !?8,"c1B",?16,"c1C",?24,"c2",?32,"c2A",?40,"c2B",?48,"c2C"
- +4 WRITE !?8,"c3",?16,"c3A",?24,"c3B",?32,"c3C",?40,"c4",?48,88,!
- +5 QUIT
- MCLINHP ;
- +1 WRITE !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR CLINICAL M"
- +2 WRITE !?8,"c0",?16,"c0I+",?24,"c1",?32,"c1A",?40,"c1B"
- +3 WRITE !?8,"c1C",?16,"c1D",?24,"c1E",?32,"p1",?40,"p1A"
- +4 WRITE !?8,"p1B",?16,"p1C",?24,"p1D",?32,"p1E",?40,88
- +5 IF DATEDX<3100101
- WRITE ?48,"cX"
- +6 WRITE !
- QUIT
- TPATHHP ;
- +1 WRITE !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR PATHOLOGIC T"
- +2 WRITE !?8,"pX",?16,"p0",?24,"pA",?32,"pIS",?40,"pISU",?48,"pISD"
- +3 WRITE !?8,"p1MI",?16,"p1",?24,"p1A",?32,"p1A1",?40,"p1A2",?48,"p1B"
- +4 WRITE !?8,"p1B1",?16,"p1B2",?24,"p1C",?32,"p1D",?40,"p2",?48,"p2A"
- +5 WRITE !?8,"p2A1",?16,"p2A2",?24,"p2B",?32,"p2C",?40,"p2D",?48,"p3"
- +6 WRITE !?8,"p3A",?16,"p3B",?24,"p3C",?32,"p3D",?40,"p4",?48,"p4A"
- +7 WRITE !?8,"p4B",?16,"p4C",?24,"p4D",?32,"p4E",?40,88,!
- +8 QUIT
- NPATHHP ;
- +1 WRITE !?5,"PLEASE SELECT FROM THE FOLLOWING CODES FOR PATHOLOGIC N"
- +2 WRITE !?8,"pX",?16,"c0",?24,"p0",?32,"p0I-",?40,"p0I+"
- +3 WRITE !?8,"p0M-",?16,"p0M+",?24,"p1MI",?32,"p0A",?40,"p0B"
- +4 WRITE !?8,"p1",?16,"p1A",?24,"p1B",?32,"p1C",?40,"p2"
- +5 WRITE !?8,"p2A",?16,"p2B",?24,"p2C",?32,"p3",?40,"p3A"
- +6 WRITE !?8,"p3B",?16,"p3C",?24,"p4",?32,88
- +7 IF DATEDX<3020101
- WRITE !?8,"p1BI",?16,"p1BII",?24,"p1BIII",?32,"p1BIV"
- +8 WRITE !
- QUIT
- MPATHHP ;
- +1 WRITE !?8,"c0",?16,"c0I+",?24,"p1",?32,"p1A",?40,"p1B"
- +2 WRITE !?8,"p1C",?16,"p1D",?24,"p1E",?32,"c1",?40,"c1A"
- +3 WRITE !?8,"c1B",?16,"c1C",?24,"c1D",?32,"c1E",?40,88
- +4 IF DATEDX<3100101
- WRITE ?48,"pX"
- +5 WRITE !
- QUIT
- +6 ;
- VALID ;check the validity of the Clinical and Pathologic TNM data values
- +1 ; after the Patch 6 converion for NAACCR Vol II v16
- +2 NEW X,EX
- KILL ^TMP($JOB,"ONCINV")
- SET NN=0
- SET EX=""
- +3 ;loop through and check if any of the 6 TNM fields have bad data
- +4 FOR IEN=0:0
- SET IEN=$ORDER(^ONCO(165.5,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:1
- +5 SET DATEDX=$PIECE($GET(^ONCO(165.5,IEN,0)),"^",16)
- +6 SET CLINT=$PIECE($GET(^ONCO(165.5,IEN,2)),U,25)
- SET X=CLINT
- IF X=""!(X=88)
- QUIT
- +7 DO TCLIN
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"CLINICAL T")=ZZACSQ_U_CLINT
- +8 SET CLINN=$PIECE($GET(^ONCO(165.5,IEN,2)),U,26)
- SET X=CLINN
- IF X=""!(X=88)
- QUIT
- +9 DO NCLIN
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"CLINICAL N")=ZZACSQ_U_CLINN
- +10 SET CLINM=$PIECE($GET(^ONCO(165.5,IEN,2)),U,27)
- SET X=CLINM
- IF X=""!(X=88)
- QUIT
- +11 DO MCLIN
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"CLINICAL M")=ZZACSQ_U_CLINM
- +12 SET PATHT=$PIECE($GET(^ONCO(165.5,IEN,2.1)),U,1)
- SET X=PATHT
- IF X=""!(X=88)
- QUIT
- +13 DO TPATH
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC T")=ZZACSQ_U_PATHT
- +14 SET PATHN=$PIECE($GET(^ONCO(165.5,IEN,2.1)),U,2)
- SET X=PATHN
- IF X=""!(X=88)
- QUIT
- +15 DO NPATH
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC N")=ZZACSQ_U_PATHN
- +16 SET PATHM=$PIECE($GET(^ONCO(165.5,IEN,2.1)),U,3)
- SET X=PATHM
- IF X=""!(X=88)
- QUIT
- +17 DO MPATH
- IF '$DATA(X)
- DO GETPTV
- SET ^TMP($JOB,"ONCINV",ZZPTNM,IEN,"PATHOLOGIC M")=ZZACSQ_U_PATHM
- End DoDot:1
- +18 WRITE !
- +19 ;display the invalid data, if any
- +20 IF '$DATA(^TMP($JOB,"ONCINV"))
- WRITE !?3,"All Clinical and Pathologic TNM data is valid!",!
- KILL CLINT,CLINN,CLINM,PATHT,PATHN,PATHM,IEN,NN,TNMFLD,ZZ160,ZZVRPT,ZZPTNM,ZZACSQ,^TMP($JOB,"ONCINV")
- QUIT
- +21 WRITE @IOF,!!!,"Display list of patients with invalid data in"
- +22 WRITE !,"the Clinical or Pathologic TNM fields",!
- +23 SET ZZPTNM=""
- FOR
- SET ZZPTNM=$ORDER(^TMP($JOB,"ONCINV",ZZPTNM))
- if ZZPTNM=""!(EX=U)
- QUIT
- Begin DoDot:1
- +24 FOR IEN=0:0
- SET IEN=$ORDER(^TMP($JOB,"ONCINV",ZZPTNM,IEN))
- if IEN'>0!(EX=U)
- QUIT
- Begin DoDot:2
- +25 SET NN=NN+1
- WRITE !!,"Patient Name: ",ZZPTNM
- +26 SET TNMFLD=""
- FOR
- SET TNMFLD=$ORDER(^TMP($JOB,"ONCINV",ZZPTNM,IEN,TNMFLD))
- if TNMFLD=""!(EX=U)
- QUIT
- Begin DoDot:3
- +27 WRITE !," Acc/Seq #: ",$PIECE(^TMP($JOB,"ONCINV",ZZPTNM,IEN,TNMFLD),"^",1)," ",TNMFLD," invalid value = ",$PIECE(^TMP($JOB,"ONCINV",ZZPTNM,IEN,TNMFLD),"^",2)
- +28 IF $Y>(IOSL-4)
- DO PG
- IF EX=U
- QUIT
- End DoDot:3
- +29 QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 IF EX'=U
- WRITE !!?9,NN," total patient records with invalid TNM data...",!
- DO PG
- IF EX=U
- QUIT
- +32 ;,^TMP($J,"ONCINV") Q
- KILL CLINT,CLINN,CLINM,PATHT,PATHN,PATHM,IEN,NN,TNMFLD,ZZ160,ZZVRPT,ZZPTNM,ZZACSQ
- +33 QUIT
- +34 ;
- GETPTV ;
- +1 SET ZZ160=$PIECE($GET(^ONCO(165.5,IEN,0)),"^",2)
- +2 SET ZZVRPT=$PIECE($GET(^ONCO(160,ZZ160,0)),"^",1)
- +3 IF ZZVRPT[";DPT"
- SET ZZPTNM=$PIECE($GET(^DPT($PIECE(ZZVRPT,";",1),0)),"^",1)
- +4 IF ZZVRPT[";LRT"
- SET ZZPTNM=$PIECE($GET(^LRT(67,$PIECE(ZZVRPT,";",1),0)),"^",1)
- +5 SET ZZACSQ=$EXTRACT($PIECE($GET(^ONCO(165.5,IEN,0)),"^",5),1,4)_"-"_$EXTRACT($PIECE($GET(^ONCO(165.5,IEN,0)),"^",5),5,9)_"/"_$PIECE($GET(^ONCO(165.5,IEN,0)),"^",6)
- +6 QUIT
- +7 ;
- PG ;
- +1 IF IOST?1"C".E
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET EX=U
- QUIT
- +2 WRITE @IOF
- QUIT