ONCCSRS1 ;HINES OIFO/GWB,RTK - Re-stage using current version ;07/02/24
;;2.2;ONCOLOGY;**20**;Jul 31, 2013;Build 5
;
;Re-stage 2004-2017 completed cases using current/final CS Version (020550)
;updated for cloud migration
K DIRUT
N ONCZZIS,IOP,POP
S ONCZZIS="MQ"
D OPEN^%ZISUTL("ONCCSRS1",,.ONCZZIS) Q:$G(POP)
D USE^%ZISUTL("ONCCSRS1")
I $D(IO("Q")) D TASK G END
D RS D CLOSE^%ZISUTL("ONCCSRS1") G END
Q
;
RS ;Re-stage
D SAVDEV^%ZISUTL("ONCCSRS1")
;S VER=$P($$VERSION^ONCSAPIV,U,2)
S VER="020550" ; can hard code b/c CS is obsolete and last version was 020550
S VERDSP=$E(VER,1,2)_"."_$E(VER,3,4)_"."_$E(VER,5,6)
S DIVISION=$P(^DIC(4,DUZ(2),0),U,1)
D USE^%ZISUTL("ONCCSRS")
W !?3,"Restaging using CS Version ",VERDSP," for ",DIVISION,!
S CTR=0,SUCCTR=0,ERRCTR=0
S XDT=3040000 F S XDT=$O(^ONCO(165.5,"ADX",XDT)) Q:XDT="" S IEN=0 F S IEN=$O(^ONCO(165.5,"ADX",XDT,IEN)) Q:IEN="" I $$DIV^ONCFUNC(IEN)=DUZ(2) D G:$G(DIRUT)=1 EXIT
.I XDT>3171231 Q ;CS obsolete after 2017
.;added by p2.2*1; only do cs if status is complete.
.;Q:$$GET1^DIQ(165.5,IEN,91,"I")'=3
.;added p57 for 96703 histology
.I (XDT>3120000),($P($G(^ONCO(165.5,IEN,2.2)),U,3)=96703) D Q
..W !!,"Starting 2012, ","Histology 96703 is obsolete for patient: "
..W $$GET1^DIQ(165.5,IEN,61)," ",$$GET1^DIQ(165.5,IEN,.02)," ",$$GET1^DIQ(165.5,IEN,.05),"/",$$GET1^DIQ(165.5,IEN,.06)
..N ONPIC
..F ONPIC=1:1:12 S $P(^ONCO(165.5,IEN,"CS"),U,ONPIC)=""
..F ONPIC=1:1:19 S $P(^ONCO(165.5,IEN,"CS1"),U,ONPIC)=""
..F ONPIC=1:1:19 S $P(^ONCO(165.5,IEN,"CS2"),U,ONPIC)=""
..S $P(^ONCO(165.5,IEN,"CS3"),U,1)=""
..S ERRCTR=ERRCTR+1
.I $P($G(^ONCO(165.5,IEN,"CS1")),U,11)="" Q
.I +$P($G(^ONCO(165.5,IEN,"CS1")),U,11)>+VER Q
.I $P($G(^ONCO(165.5,IEN,"CS1")),U,11)=VER Q
.S PN=$$GET1^DIQ(165.5,IEN,.02)
.S AN=$$GET1^DIQ(165.5,IEN,.05)
.S SEQ=$$GET1^DIQ(165.5,IEN,.06)
.S PID=$$GET1^DIQ(165.5,IEN,61)
.S PSCODE=$$GET1^DIQ(165.5,IEN,20.1)
.K INPUT,STORE,DISPLAY,STATUS,ONCSAPI
.;D CLEAR^ONCSAPIE(1)
.S PS=$$GET1^DIQ(165.5,IEN,20,"I")
.S:PS'="" PS=$TR($$GET1^DIQ(164,PS,1,"I"),".","")
.S INPUT("SITE")=PS
.S INPUT("HIST")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
.S INPUT("DIAGNOSIS_YEAR")=$E($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
.S INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
.S INPUT("BEHAV")=$E($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
.S INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
.S INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
.S:$L(INPUT("AGE"))=1 INPUT("AGE")="00"_INPUT("AGE")
.S:$L(INPUT("AGE"))=2 INPUT("AGE")=0_INPUT("AGE")
.S LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
.S INPUT("LVI")=$S(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
.S INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
.S INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
.S INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
.S INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
.S:$L(INPUT("LNPOS"))=1 INPUT("LNPOS")=0_INPUT("LNPOS")
.S INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
.S:$L(INPUT("LNEXAM"))=1 INPUT("LNEXAM")=0_INPUT("LNEXAM")
.S INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
.S INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
.S INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
.S INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
.S INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
.S INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
.S INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
.S INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
.S INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
.S INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
.S INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
.S INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
.S INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
.S INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
.S INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
.S INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
.S INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
.S INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
.S INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
.S INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
.S INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
.S INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
.S INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
.S INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
.S INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
.S INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
.S INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
.S INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
.I $P($G(^ONCO(165.5,IEN,"CS3")),U,1)'="" D
..S $P(^ONCO(165.5,IEN,"CS2"),U,19)=$P($G(^ONCO(165.5,IEN,"CS3")),U,1)
.S INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
.S:INPUT("SSF25")="" INPUT("SSF25")=" "
.K ERRMSG,STATUS
.D XMLREQ^ONCCS
.K ^TMP("ONCCSRSP",$J) S ONCEXEC="P" D TCS^ONCWEB1
.S ERRFLG=0 D PARSECS^ONCWEBP2
.I ERRFLG=1 D DISERR^ONCWEBP2 W !," You have encountered a CS error/warning" D S CTR=CTR+1 Q
..W !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
..S ERRCTR=ERRCTR+1
.I ERRFLG=2 W !," You have encountered an XML/server problem" D S CTR=CTR+1 Q
..W !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
..S ERRCTR=ERRCTR+1
.S ERRFLG=0 D
..S SUCCTR=SUCCTR+1
..W !," You have successfully re-staged ",PID," ",PSCODE," ",AN,"/",SEQ
..S $P(^ONCO(165.5,IEN,"CS1"),U,1)=ONCSTORE("T")
..S $P(^ONCO(165.5,IEN,"CS1"),U,2)=ONCSTORE("TDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,3)=ONCSTORE("N")
..S $P(^ONCO(165.5,IEN,"CS1"),U,4)=ONCSTORE("NDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,5)=ONCSTORE("M")
..S $P(^ONCO(165.5,IEN,"CS1"),U,6)=ONCSTORE("MDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,7)=ONCSTORE("AJCC")
..S $P(^ONCO(165.5,IEN,"CS1"),U,8)=ONCSTORE("SS1977")
..S $P(^ONCO(165.5,IEN,"CS1"),U,9)=ONCSTORE("SS2000")
..S $P(^ONCO(165.5,IEN,"CS1"),U,11)="020550" ;hard set to the latest version
..S $P(^ONCO(165.5,IEN,"CS1"),U,13)=ONCSTORE("AJCC7-T")
..S $P(^ONCO(165.5,IEN,"CS1"),U,14)=ONCSTORE("AJCC7-TDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,15)=ONCSTORE("AJCC7-N")
..S $P(^ONCO(165.5,IEN,"CS1"),U,16)=ONCSTORE("AJCC7-NDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,17)=ONCSTORE("AJCC7-M")
..S $P(^ONCO(165.5,IEN,"CS1"),U,18)=ONCSTORE("AJCC7-MDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,19)=ONCSTORE("AJCC7-STAGE")
.S CTR=CTR+1 W "."
;
EXIT W !
S TAB=$S($L(CTR)=1:5,$L(CTR)=2:4,$L(CTR)=3:3,1:3)
S SUCTAB=$S($L(SUCCTR)=1:5,$L(SUCCTR)=2:4,$L(SUCCTR)=3:3,1:3)
S ERRTAB=$S($L(ERRCTR)=1:5,$L(ERRCTR)=2:4,$L(ERRCTR)=3:3,1:3)
;
W:CTR=1 !?TAB,CTR," primary was re-staged using CS Version ",VERDSP
W:CTR'=1 !?TAB,CTR," primaries were re-staged using CS Version ",VERDSP
W !
W:SUCCTR=1 !?SUCTAB,SUCCTR," primary was successfully restaged"
W:SUCCTR'=1 !?SUCTAB,SUCCTR," primaries were successfully restaged"
W:ERRCTR=1 !?ERRTAB,ERRCTR," primary encountered an error or warning"
W:ERRCTR'=1 !?ERRTAB,ERRCTR," primaries encountered errors or warnings"
D ^%ZISC
I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E" D ^DIR
Q
;
TASK ;Queue a task
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="RS^ONCCSRS1",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="ONCOTRAX Restage CS"
D ^%ZTLOAD D CLOSE^%ZISUTL("ONCCSRS1") W !,"Request Queued",!
K ZTSK
Q
;
END ;Cleanup
K AN,CHECKSUM,CTR,D0,DIVISION,ERRCTR,ERRTAB,IEN,LV,ONCDST,PID,PN,PS
K PSCODE,RC,SEQ,SUCCTR,SUCTAB,TAB,VER,VERDSP,XDT,ZTDESC,ZTREQ,ZTRTN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCCSRS1 7446 printed Nov 22, 2024@17:32:47 Page 2
ONCCSRS1 ;HINES OIFO/GWB,RTK - Re-stage using current version ;07/02/24
+1 ;;2.2;ONCOLOGY;**20**;Jul 31, 2013;Build 5
+2 ;
+3 ;Re-stage 2004-2017 completed cases using current/final CS Version (020550)
+4 ;updated for cloud migration
+5 KILL DIRUT
+6 NEW ONCZZIS,IOP,POP
+7 SET ONCZZIS="MQ"
+8 DO OPEN^%ZISUTL("ONCCSRS1",,.ONCZZIS)
if $GET(POP)
QUIT
+9 DO USE^%ZISUTL("ONCCSRS1")
+10 IF $DATA(IO("Q"))
DO TASK
GOTO END
+11 DO RS
DO CLOSE^%ZISUTL("ONCCSRS1")
GOTO END
+12 QUIT
+13 ;
RS ;Re-stage
+1 DO SAVDEV^%ZISUTL("ONCCSRS1")
+2 ;S VER=$P($$VERSION^ONCSAPIV,U,2)
+3 ; can hard code b/c CS is obsolete and last version was 020550
SET VER="020550"
+4 SET VERDSP=$EXTRACT(VER,1,2)_"."_$EXTRACT(VER,3,4)_"."_$EXTRACT(VER,5,6)
+5 SET DIVISION=$PIECE(^DIC(4,DUZ(2),0),U,1)
+6 DO USE^%ZISUTL("ONCCSRS")
+7 WRITE !?3,"Restaging using CS Version ",VERDSP," for ",DIVISION,!
+8 SET CTR=0
SET SUCCTR=0
SET ERRCTR=0
+9 SET XDT=3040000
FOR
SET XDT=$ORDER(^ONCO(165.5,"ADX",XDT))
if XDT=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"ADX",XDT,IEN))
if IEN=""
QUIT
IF $$DIV^ONCFUNC(IEN)=DUZ(2)
Begin DoDot:1
+10 ;CS obsolete after 2017
IF XDT>3171231
QUIT
+11 ;added by p2.2*1; only do cs if status is complete.
+12 ;Q:$$GET1^DIQ(165.5,IEN,91,"I")'=3
+13 ;added p57 for 96703 histology
+14 IF (XDT>3120000)
IF ($PIECE($GET(^ONCO(165.5,IEN,2.2)),U,3)=96703)
Begin DoDot:2
+15 WRITE !!,"Starting 2012, ","Histology 96703 is obsolete for patient: "
+16 WRITE $$GET1^DIQ(165.5,IEN,61)," ",$$GET1^DIQ(165.5,IEN,.02)," ",$$GET1^DIQ(165.5,IEN,.05),"/",$$GET1^DIQ(165.5,IEN,.06)
+17 NEW ONPIC
+18 FOR ONPIC=1:1:12
SET $PIECE(^ONCO(165.5,IEN,"CS"),U,ONPIC)=""
+19 FOR ONPIC=1:1:19
SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,ONPIC)=""
+20 FOR ONPIC=1:1:19
SET $PIECE(^ONCO(165.5,IEN,"CS2"),U,ONPIC)=""
+21 SET $PIECE(^ONCO(165.5,IEN,"CS3"),U,1)=""
+22 SET ERRCTR=ERRCTR+1
End DoDot:2
QUIT
+23 IF $PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)=""
QUIT
+24 IF +$PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)>+VER
QUIT
+25 IF $PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)=VER
QUIT
+26 SET PN=$$GET1^DIQ(165.5,IEN,.02)
+27 SET AN=$$GET1^DIQ(165.5,IEN,.05)
+28 SET SEQ=$$GET1^DIQ(165.5,IEN,.06)
+29 SET PID=$$GET1^DIQ(165.5,IEN,61)
+30 SET PSCODE=$$GET1^DIQ(165.5,IEN,20.1)
+31 KILL INPUT,STORE,DISPLAY,STATUS,ONCSAPI
+32 ;D CLEAR^ONCSAPIE(1)
+33 SET PS=$$GET1^DIQ(165.5,IEN,20,"I")
+34 if PS'=""
SET PS=$TRANSLATE($$GET1^DIQ(164,PS,1,"I"),".","")
+35 SET INPUT("SITE")=PS
+36 SET INPUT("HIST")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
+37 SET INPUT("DIAGNOSIS_YEAR")=$EXTRACT($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
+38 SET INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
+39 SET INPUT("BEHAV")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
+40 SET INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
+41 SET INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
+42 if $LENGTH(INPUT("AGE"))=1
SET INPUT("AGE")="00"_INPUT("AGE")
+43 if $LENGTH(INPUT("AGE"))=2
SET INPUT("AGE")=0_INPUT("AGE")
+44 SET LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
+45 SET INPUT("LVI")=$SELECT(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
+46 SET INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
+47 SET INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
+48 SET INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
+49 SET INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
+50 if $LENGTH(INPUT("LNPOS"))=1
SET INPUT("LNPOS")=0_INPUT("LNPOS")
+51 SET INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
+52 if $LENGTH(INPUT("LNEXAM"))=1
SET INPUT("LNEXAM")=0_INPUT("LNEXAM")
+53 SET INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
+54 SET INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
+55 SET INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
+56 SET INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
+57 SET INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
+58 SET INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
+59 SET INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
+60 SET INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
+61 SET INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
+62 SET INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
+63 SET INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
+64 SET INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
+65 SET INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
+66 SET INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
+67 SET INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
+68 SET INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
+69 SET INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
+70 SET INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
+71 SET INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
+72 SET INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
+73 SET INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
+74 SET INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
+75 SET INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
+76 SET INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
+77 SET INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
+78 SET INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
+79 SET INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
+80 SET INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
+81 IF $PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)'=""
Begin DoDot:2
+82 SET $PIECE(^ONCO(165.5,IEN,"CS2"),U,19)=$PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)
End DoDot:2
+83 SET INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
+84 if INPUT("SSF25")=""
SET INPUT("SSF25")=" "
+85 KILL ERRMSG,STATUS
+86 DO XMLREQ^ONCCS
+87 KILL ^TMP("ONCCSRSP",$JOB)
SET ONCEXEC="P"
DO TCS^ONCWEB1
+88 SET ERRFLG=0
DO PARSECS^ONCWEBP2
+89 IF ERRFLG=1
DO DISERR^ONCWEBP2
WRITE !," You have encountered a CS error/warning"
Begin DoDot:2
+90 WRITE !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
+91 SET ERRCTR=ERRCTR+1
End DoDot:2
SET CTR=CTR+1
QUIT
+92 IF ERRFLG=2
WRITE !," You have encountered an XML/server problem"
Begin DoDot:2
+93 WRITE !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
+94 SET ERRCTR=ERRCTR+1
End DoDot:2
SET CTR=CTR+1
QUIT
+95 SET ERRFLG=0
Begin DoDot:2
+96 SET SUCCTR=SUCCTR+1
+97 WRITE !," You have successfully re-staged ",PID," ",PSCODE," ",AN,"/",SEQ
+98 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,1)=ONCSTORE("T")
+99 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,2)=ONCSTORE("TDESCR")
+100 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,3)=ONCSTORE("N")
+101 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,4)=ONCSTORE("NDESCR")
+102 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,5)=ONCSTORE("M")
+103 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,6)=ONCSTORE("MDESCR")
+104 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,7)=ONCSTORE("AJCC")
+105 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,8)=ONCSTORE("SS1977")
+106 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,9)=ONCSTORE("SS2000")
+107 ;hard set to the latest version
SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,11)="020550"
+108 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,13)=ONCSTORE("AJCC7-T")
+109 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,14)=ONCSTORE("AJCC7-TDESCR")
+110 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,15)=ONCSTORE("AJCC7-N")
+111 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,16)=ONCSTORE("AJCC7-NDESCR")
+112 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,17)=ONCSTORE("AJCC7-M")
+113 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,18)=ONCSTORE("AJCC7-MDESCR")
+114 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,19)=ONCSTORE("AJCC7-STAGE")
End DoDot:2
+115 SET CTR=CTR+1
WRITE "."
End DoDot:1
if $GET(DIRUT)=1
GOTO EXIT
+116 ;
EXIT WRITE !
+1 SET TAB=$SELECT($LENGTH(CTR)=1:5,$LENGTH(CTR)=2:4,$LENGTH(CTR)=3:3,1:3)
+2 SET SUCTAB=$SELECT($LENGTH(SUCCTR)=1:5,$LENGTH(SUCCTR)=2:4,$LENGTH(SUCCTR)=3:3,1:3)
+3 SET ERRTAB=$SELECT($LENGTH(ERRCTR)=1:5,$LENGTH(ERRCTR)=2:4,$LENGTH(ERRCTR)=3:3,1:3)
+4 ;
+5 if CTR=1
WRITE !?TAB,CTR," primary was re-staged using CS Version ",VERDSP
+6 if CTR'=1
WRITE !?TAB,CTR," primaries were re-staged using CS Version ",VERDSP
+7 WRITE !
+8 if SUCCTR=1
WRITE !?SUCTAB,SUCCTR," primary was successfully restaged"
+9 if SUCCTR'=1
WRITE !?SUCTAB,SUCCTR," primaries were successfully restaged"
+10 if ERRCTR=1
WRITE !?ERRTAB,ERRCTR," primary encountered an error or warning"
+11 if ERRCTR'=1
WRITE !?ERRTAB,ERRCTR," primaries encountered errors or warnings"
+12 DO ^%ZISC
+13 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
+14 QUIT
+15 ;
TASK ;Queue a task
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="RS^ONCCSRS1"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="ONCOTRAX Restage CS"
+4 DO ^%ZTLOAD
DO CLOSE^%ZISUTL("ONCCSRS1")
WRITE !,"Request Queued",!
+5 KILL ZTSK
+6 QUIT
+7 ;
END ;Cleanup
+1 KILL AN,CHECKSUM,CTR,D0,DIVISION,ERRCTR,ERRTAB,IEN,LV,ONCDST,PID,PN,PS
+2 KILL PSCODE,RC,SEQ,SUCCTR,SUCTAB,TAB,VER,VERDSP,XDT,ZTDESC,ZTREQ,ZTRTN
+3 QUIT
