ONCCSRS ;HINES OIFO/GWB - Re-stage using current version ;11/04/11
;;2.2;ONCOLOGY;**1,20**;Jul 31, 2013;Build 5
;
;Re-stage 2004+ cases using current CS Version
D ^ONCCSRS1 Q ;update for cloud migration -- use ONCCSRS1 routine
;
K DIRUT
N ONCZZIS,IOP,POP
S ONCZZIS="MQ"
D OPEN^%ZISUTL("ONCCSRS",,.ONCZZIS) Q:$G(POP)
D USE^%ZISUTL("ONCCSRS")
I $D(IO("Q")) D TASK G END
D RS D CLOSE^%ZISUTL("ONCCSRS") G END
Q
;
RS ;Re-stage
D SAVDEV^%ZISUTL("ONCCSRS")
S VER=$P($$VERSION^ONCSAPIV,U,2)
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
.;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
.S RC=$$CALC^ONCSAPI3(.ONCSAPI,.INPUT,.STORE,.DISPLAY,.STATUS)
.D USE^%ZISUTL("ONCCSRS")
.I $P(RC,U,1)<0 D
..S ERRMSG=$P($G(STATUS("MSG",1)),".",1)
..W !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
..W !?3,ERRMSG
..S ERRCTR=ERRCTR+1
.I $P(RC,U,1)>0 D
..S ERRMSG=$P($G(STATUS("MSG",1)),".",1)
..W !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS warning"
..W !?3,ERRMSG
..S ERRCTR=ERRCTR+1
.I $P(RC,U,1)=0 S SUCCTR=SUCCTR+1 D
..S $P(^ONCO(165.5,IEN,"CS1"),U,1)=STORE("T")
..S $P(^ONCO(165.5,IEN,"CS1"),U,2)=STORE("TDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,3)=STORE("N")
..S $P(^ONCO(165.5,IEN,"CS1"),U,4)=STORE("NDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,5)=STORE("M")
..S $P(^ONCO(165.5,IEN,"CS1"),U,6)=STORE("MDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,7)=STORE("AJCC")
..S $P(^ONCO(165.5,IEN,"CS1"),U,8)=STORE("SS1977")
..S $P(^ONCO(165.5,IEN,"CS1"),U,9)=STORE("SS2000")
..S $P(^ONCO(165.5,IEN,"CS1"),U,11)=$G(STATUS("APIVER"))
..S $P(^ONCO(165.5,IEN,"CS1"),U,13)=STORE("AJCC7-T")
..S $P(^ONCO(165.5,IEN,"CS1"),U,14)=STORE("AJCC7-TDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,15)=STORE("AJCC7-N")
..S $P(^ONCO(165.5,IEN,"CS1"),U,16)=STORE("AJCC7-NDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,17)=STORE("AJCC7-M")
..S $P(^ONCO(165.5,IEN,"CS1"),U,18)=STORE("AJCC7-MDESCR")
..S $P(^ONCO(165.5,IEN,"CS1"),U,19)=STORE("AJCC7-STAGE")
.S CTR=CTR+1 W "."
D RMDEV^%ZISUTL("ONCCSRS")
;
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^ONCCSRS",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="ONCOTRAX Restage CS"
D ^%ZTLOAD D CLOSE^%ZISUTL("ONCCSRS") 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[HONCCSRS 7181 printed Dec 13, 2024@02:22:44 Page 2
ONCCSRS ;HINES OIFO/GWB - Re-stage using current version ;11/04/11
+1 ;;2.2;ONCOLOGY;**1,20**;Jul 31, 2013;Build 5
+2 ;
+3 ;Re-stage 2004+ cases using current CS Version
+4 ;update for cloud migration -- use ONCCSRS1 routine
DO ^ONCCSRS1
QUIT
+5 ;
+6 KILL DIRUT
+7 NEW ONCZZIS,IOP,POP
+8 SET ONCZZIS="MQ"
+9 DO OPEN^%ZISUTL("ONCCSRS",,.ONCZZIS)
if $GET(POP)
QUIT
+10 DO USE^%ZISUTL("ONCCSRS")
+11 IF $DATA(IO("Q"))
DO TASK
GOTO END
+12 DO RS
DO CLOSE^%ZISUTL("ONCCSRS")
GOTO END
+13 QUIT
+14 ;
RS ;Re-stage
+1 DO SAVDEV^%ZISUTL("ONCCSRS")
+2 SET VER=$PIECE($$VERSION^ONCSAPIV,U,2)
+3 SET VERDSP=$EXTRACT(VER,1,2)_"."_$EXTRACT(VER,3,4)_"."_$EXTRACT(VER,5,6)
+4 SET DIVISION=$PIECE(^DIC(4,DUZ(2),0),U,1)
+5 DO USE^%ZISUTL("ONCCSRS")
+6 WRITE !?3,"Restaging using CS Version ",VERDSP," for ",DIVISION
+7 SET CTR=0
SET SUCCTR=0
SET ERRCTR=0
+8 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
+9 ;added by p2.2*1; only do cs if status is complete.
+10 if $$GET1^DIQ(165.5,IEN,91,"I")'=3
QUIT
+11 ;added p57 for 96703 histology
+12 IF (XDT>3120000)
IF ($PIECE($GET(^ONCO(165.5,IEN,2.2)),U,3)=96703)
Begin DoDot:2
+13 WRITE !!,"Starting 2012, ","Histology 96703 is obsolete for patient: "
+14 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)
+15 NEW ONPIC
+16 FOR ONPIC=1:1:12
SET $PIECE(^ONCO(165.5,IEN,"CS"),U,ONPIC)=""
+17 FOR ONPIC=1:1:19
SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,ONPIC)=""
+18 FOR ONPIC=1:1:19
SET $PIECE(^ONCO(165.5,IEN,"CS2"),U,ONPIC)=""
+19 SET $PIECE(^ONCO(165.5,IEN,"CS3"),U,1)=""
+20 SET ERRCTR=ERRCTR+1
End DoDot:2
QUIT
+21 IF $PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)=""
QUIT
+22 IF +$PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)>+VER
QUIT
+23 IF $PIECE($GET(^ONCO(165.5,IEN,"CS1")),U,11)=VER
QUIT
+24 SET PN=$$GET1^DIQ(165.5,IEN,.02)
+25 SET AN=$$GET1^DIQ(165.5,IEN,.05)
+26 SET SEQ=$$GET1^DIQ(165.5,IEN,.06)
+27 SET PID=$$GET1^DIQ(165.5,IEN,61)
+28 SET PSCODE=$$GET1^DIQ(165.5,IEN,20.1)
+29 KILL INPUT,STORE,DISPLAY,STATUS,ONCSAPI
+30 DO CLEAR^ONCSAPIE(1)
+31 SET PS=$$GET1^DIQ(165.5,IEN,20,"I")
+32 if PS'=""
SET PS=$TRANSLATE($$GET1^DIQ(164,PS,1,"I"),".","")
+33 SET INPUT("SITE")=PS
+34 SET INPUT("HIST")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),1,4)
+35 SET INPUT("DIAGNOSIS_YEAR")=$EXTRACT($$DATE^ONCACDU1($$GET1^DIQ(165.5,IEN,3,"I")),1,4)
+36 SET INPUT("CSVER_ORIGINAL")=$$GET1^DIQ(165.5,IEN,169.1,"I")
+37 SET INPUT("BEHAV")=$EXTRACT($$GET1^DIQ(165.5,IEN,22.3,"I"),5)
+38 SET INPUT("GRADE")=$$GET1^DIQ(165.5,IEN,24,"I")
+39 SET INPUT("AGE")=$$AGEDX^ONCACDU1(IEN)
+40 if $LENGTH(INPUT("AGE"))=1
SET INPUT("AGE")="00"_INPUT("AGE")
+41 if $LENGTH(INPUT("AGE"))=2
SET INPUT("AGE")=0_INPUT("AGE")
+42 SET LV=$$GET1^DIQ(165.5,IEN,149,"I")_$$GET1^DIQ(165.5,IEN,151,"I")
+43 SET INPUT("LVI")=$SELECT(LV[1:1,LV[2:1,LV[0:0,LV["X":9,1:8)
+44 SET INPUT("SIZE")=$$GET1^DIQ(165.5,IEN,29.2,"I")
+45 SET INPUT("EXT")=$$GET1^DIQ(165.5,IEN,30.2,"I")
+46 SET INPUT("EXTEVAL")=$$GET1^DIQ(165.5,IEN,29.1,"I")
+47 SET INPUT("LNPOS")=$$GET1^DIQ(165.5,IEN,32,"I")
+48 if $LENGTH(INPUT("LNPOS"))=1
SET INPUT("LNPOS")=0_INPUT("LNPOS")
+49 SET INPUT("LNEXAM")=$$GET1^DIQ(165.5,IEN,33,"I")
+50 if $LENGTH(INPUT("LNEXAM"))=1
SET INPUT("LNEXAM")=0_INPUT("LNEXAM")
+51 SET INPUT("METS")=$$GET1^DIQ(165.5,IEN,34.3,"I")
+52 SET INPUT("METSEVAL")=$$GET1^DIQ(165.5,IEN,34.4,"I")
+53 SET INPUT("NODES")=$$GET1^DIQ(165.5,IEN,31.1,"I")
+54 SET INPUT("NODESEVAL")=$$GET1^DIQ(165.5,IEN,32.1,"I")
+55 SET INPUT("SSF1")=$$GET1^DIQ(165.5,IEN,44.1,"I")
+56 SET INPUT("SSF2")=$$GET1^DIQ(165.5,IEN,44.2,"I")
+57 SET INPUT("SSF3")=$$GET1^DIQ(165.5,IEN,44.3,"I")
+58 SET INPUT("SSF4")=$$GET1^DIQ(165.5,IEN,44.4,"I")
+59 SET INPUT("SSF5")=$$GET1^DIQ(165.5,IEN,44.5,"I")
+60 SET INPUT("SSF6")=$$GET1^DIQ(165.5,IEN,44.6,"I")
+61 SET INPUT("SSF7")=$$GET1^DIQ(165.5,IEN,44.7,"I")
+62 SET INPUT("SSF8")=$$GET1^DIQ(165.5,IEN,44.8,"I")
+63 SET INPUT("SSF9")=$$GET1^DIQ(165.5,IEN,44.9,"I")
+64 SET INPUT("SSF10")=$$GET1^DIQ(165.5,IEN,44.101,"I")
+65 SET INPUT("SSF11")=$$GET1^DIQ(165.5,IEN,44.11,"I")
+66 SET INPUT("SSF12")=$$GET1^DIQ(165.5,IEN,44.12,"I")
+67 SET INPUT("SSF13")=$$GET1^DIQ(165.5,IEN,44.13,"I")
+68 SET INPUT("SSF14")=$$GET1^DIQ(165.5,IEN,44.14,"I")
+69 SET INPUT("SSF15")=$$GET1^DIQ(165.5,IEN,44.15,"I")
+70 SET INPUT("SSF16")=$$GET1^DIQ(165.5,IEN,44.16,"I")
+71 SET INPUT("SSF17")=$$GET1^DIQ(165.5,IEN,44.17,"I")
+72 SET INPUT("SSF18")=$$GET1^DIQ(165.5,IEN,44.18,"I")
+73 SET INPUT("SSF19")=$$GET1^DIQ(165.5,IEN,44.19,"I")
+74 SET INPUT("SSF20")=$$GET1^DIQ(165.5,IEN,44.201,"I")
+75 SET INPUT("SSF21")=$$GET1^DIQ(165.5,IEN,44.21,"I")
+76 SET INPUT("SSF22")=$$GET1^DIQ(165.5,IEN,44.22,"I")
+77 SET INPUT("SSF23")=$$GET1^DIQ(165.5,IEN,44.23,"I")
+78 SET INPUT("SSF24")=$$GET1^DIQ(165.5,IEN,44.24,"I")
+79 IF $PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)'=""
Begin DoDot:2
+80 SET $PIECE(^ONCO(165.5,IEN,"CS2"),U,19)=$PIECE($GET(^ONCO(165.5,IEN,"CS3")),U,1)
End DoDot:2
+81 SET INPUT("SSF25")=$$GET1^DIQ(165.5,IEN,44.25,"I")
+82 if INPUT("SSF25")=""
SET INPUT("SSF25")=" "
+83 KILL ERRMSG,STATUS
+84 SET RC=$$CALC^ONCSAPI3(.ONCSAPI,.INPUT,.STORE,.DISPLAY,.STATUS)
+85 DO USE^%ZISUTL("ONCCSRS")
+86 IF $PIECE(RC,U,1)<0
Begin DoDot:2
+87 SET ERRMSG=$PIECE($GET(STATUS("MSG",1)),".",1)
+88 WRITE !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS error"
+89 WRITE !?3,ERRMSG
+90 SET ERRCTR=ERRCTR+1
End DoDot:2
+91 IF $PIECE(RC,U,1)>0
Begin DoDot:2
+92 SET ERRMSG=$PIECE($GET(STATUS("MSG",1)),".",1)
+93 WRITE !!?3,PID," ",PSCODE," ",AN,"/",SEQ," encountered a CS warning"
+94 WRITE !?3,ERRMSG
+95 SET ERRCTR=ERRCTR+1
End DoDot:2
+96 IF $PIECE(RC,U,1)=0
SET SUCCTR=SUCCTR+1
Begin DoDot:2
+97 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,1)=STORE("T")
+98 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,2)=STORE("TDESCR")
+99 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,3)=STORE("N")
+100 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,4)=STORE("NDESCR")
+101 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,5)=STORE("M")
+102 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,6)=STORE("MDESCR")
+103 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,7)=STORE("AJCC")
+104 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,8)=STORE("SS1977")
+105 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,9)=STORE("SS2000")
+106 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,11)=$GET(STATUS("APIVER"))
+107 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,13)=STORE("AJCC7-T")
+108 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,14)=STORE("AJCC7-TDESCR")
+109 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,15)=STORE("AJCC7-N")
+110 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,16)=STORE("AJCC7-NDESCR")
+111 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,17)=STORE("AJCC7-M")
+112 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,18)=STORE("AJCC7-MDESCR")
+113 SET $PIECE(^ONCO(165.5,IEN,"CS1"),U,19)=STORE("AJCC7-STAGE")
End DoDot:2
+114 SET CTR=CTR+1
WRITE "."
End DoDot:1
if $GET(DIRUT)=1
GOTO EXIT
+115 DO RMDEV^%ZISUTL("ONCCSRS")
+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^ONCCSRS"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+3 SET ZTDESC="ONCOTRAX Restage CS"
+4 DO ^%ZTLOAD
DO CLOSE^%ZISUTL("ONCCSRS")
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
