ONCOPMA ;Hines OIFO/GWB [MA Print QA/Multiple Abstracts] ;10/30/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
EN ;Select Report Type
K DIR S DIR("A")=" Select Report"
S DIR(0)="SO^1:QA Abstract;2:Extended Abstract (80c);3:Complete Abstract (132c);4:Incidence Report"
D ^DIR
G EX:Y[U,EX:Y=""
S PRINT="PRT"_Y_"^ONCOPMP"
K DIR
;
OP ;Select option
S DIR(0)="SO^1:All abstracts, One PATIENT;2:All abstracts, One SITE/GP;3:All abstracts, One or more ACCESSION YEAR(s), One SITE/GP;4:All abstracts, One ACCESSION YEAR;5:Complete Abstracts by DATE DX;6:QA - 10% Complete abstracts"
S DIR("A")=" Select Option"
W ! D ^DIR G EX:Y[U,EX:Y=""
G @Y:Y<4,Y^ONCOPMB
;
1 ;[MA Print QA/Multiple Abstracts - 1 All abstracts, One PATIENT]
W ! S DIC("A")=" Select PATIENT: "
S DIC="^ONCO(160,",DIC(0)="AEMQ" D ^DIC G EX:Y<0 S ONCOXD1=+Y
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK1^ONCOPMA G EX
S ZTRTN="TK1^ONCOPMA"
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("ONCOXD1")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ESPD")=""
S ZTDESC="All abstracts, One PATIENT"
D ^%ZTLOAD
G EX
;
TK1 S ONCOXD0=0
F S ONCOXD0=$O(^ONCO(165.5,"C",ONCOXD1,ONCOXD0)) Q:ONCOXD0'>0 I $$DIV^ONCFUNC(ONCOXD0)=DUZ(2) D I $E(ONCIOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to go to next abstract or '^' to exit" D ^DIR Q:'Y
.S (NUMBER,ONCODA)=ONCOXD0
.S IOP=ONCOION
.W @IOF
.D @PRINT
.I PRINT["PRT1" D
..S IOP=ONCOION
..D 8^ONCOPMP
G EX
;
2 ;[MA Print QA/Multiple Abstracts - 2 All Abstracts, One SITE/GP]
W ! S DIC("A")=" Select SITE/GP: "
S DIC="^ONCO(164.2,",DIC(0)="AEQM" D ^DIC G EX:Y<0 S ONCOXD1=+Y
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
S %ZIS="Q" W ! D ^%ZIS I POP S ONCOOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK2^ONCOPMA G EX
S ZTRTN="TK2^ONCOPMA"
S ZTSAVE("ONCOXD1")=""
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ESPD")=""
S ZTDESC="All Abstracts, One SITE/GP"
D ^%ZTLOAD G EX
;
TK2 S ONCOXD0=0
F S ONCOXD0=$O(^ONCO(165.5,"B",ONCOXD1,ONCOXD0)) Q:ONCOXD0'>0 I $$DIV^ONCFUNC(ONCOXD0)=DUZ(2) D I $E(ONCIOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to go to next abstract or '^' to exit" D ^DIR Q:'Y W @IOF
.S (NUMBER,ONCODA)=ONCOXD0
.S IOP=ONCOION
.D @PRINT
.I PRINT["PRT1" D
..S IOP=ONCOION
..D 8^ONCOPMP
G EX
;
3 ;[MA Print QA/Multiple Abstracts - 3 All abstracts, ACCESSION YEAR(s), One SITE/GP]
S Y=3 D TF^ONCOST G EX:Y[U
S DIC("A")=" Select SITE/GP: "
S DIC(0)="AEQZ",DIC="^ONCO(164.2," D ^DIC G EX:Y<0,EX:Y=U S ONCOXD1=+Y
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK3^ONCOPMA G EX
S ZTRTN="TK3^ONCOPMA"
S ZTSAVE("ONCOXD1")=""
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ONCOS*")=""
S ZTSAVE("ESPD")=""
S ZTDESC="All abstracts, One or more ACCESSION YEAR(s), One SITE/GP"
D ^%ZTLOAD G EX
;
TK3 N ONCOXD0,SY,EY
S ONCOXD0=0
S SY=$S(ONCOS("YR")="ALL":0,1:$P(ONCOS("YR"),U,1)-1)
S EY=$S(ONCOS("YR")="ALL":9999,1:$P(ONCOS("YR"),U,2))
F S SY=$O(^ONCO(165.5,"AY",SY)) Q:(SY'>0)!(SY>EY)!($G(Y)=0) F S ONCOXD0=$O(^ONCO(165.5,"AY",SY,ONCOXD0)) Q:ONCOXD0'>0 I $$DIV^ONCFUNC(ONCOXD0)=DUZ(2),$P(^ONCO(165.5,ONCOXD0,0),U,1)=ONCOXD1 D I $E(ONCIOST,1,2)="C-" W ! D ^DIR Q:'Y W @IOF
.S (NUMBER,ONCODA)=ONCOXD0
.S IOP=ONCOION
.D @PRINT
.I $E(ONCIOST,1,2)="C-" K DIR S DIR(0)="E",DIR("A")="Enter RETURN to go to next abstract or '^' to exit"
.I PRINT["PRT1" D
..S IOP=ONCOION
..D 8^ONCOPMP
G EX
;
EX ;KILL variables
K ^TMP("ONCO",$J)
K %ZIS,DIC,DIR,IOP,NUMBER,ONCIOST,ONCODA,ONCOION,ONCOOUT,ONCOS,ONCOUT
K ONCOXD0,ONCOXD1,POP,PRINT,ZTDESC,ZTRTN,ZTSAVE
D ^%ZISC
Q
;
CLEANUP ;Cleanup
K Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPMA 3984 printed Apr 09, 2024@21:29:36 Page 2
ONCOPMA ;Hines OIFO/GWB [MA Print QA/Multiple Abstracts] ;10/30/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
EN ;Select Report Type
+1 KILL DIR
SET DIR("A")=" Select Report"
+2 SET DIR(0)="SO^1:QA Abstract;2:Extended Abstract (80c);3:Complete Abstract (132c);4:Incidence Report"
+3 DO ^DIR
+4 if Y[U
GOTO EX
if Y=""
GOTO EX
+5 SET PRINT="PRT"_Y_"^ONCOPMP"
+6 KILL DIR
+7 ;
OP ;Select option
+1 SET DIR(0)="SO^1:All abstracts, One PATIENT;2:All abstracts, One SITE/GP;3:All abstracts, One or more ACCESSION YEAR(s), One SITE/GP;4:All abstracts, One ACCESSION YEAR;5:Complete Abstracts by DATE DX;6:QA - 10% Complete abstracts"
+2 SET DIR("A")=" Select Option"
+3 WRITE !
DO ^DIR
if Y[U
GOTO EX
if Y=""
GOTO EX
+4 if Y<4
GOTO @Y
GOTO Y^ONCOPMB
+5 ;
1 ;[MA Print QA/Multiple Abstracts - 1 All abstracts, One PATIENT]
+1 WRITE !
SET DIC("A")=" Select PATIENT: "
+2 SET DIC="^ONCO(160,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y<0
GOTO EX
SET ONCOXD1=+Y
+3 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+4 SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+5 SET ONCOION=ION
SET ONCIOST=IOST
+6 IF '$DATA(IO("Q"))
DO TK1^ONCOPMA
GOTO EX
+7 SET ZTRTN="TK1^ONCOPMA"
+8 SET ZTSAVE("ONCOION")=""
+9 SET ZTSAVE("ONCIOST")=""
+10 SET ZTSAVE("ONCOXD1")=""
+11 SET ZTSAVE("PRINT")=""
+12 SET ZTSAVE("ESPD")=""
+13 SET ZTDESC="All abstracts, One PATIENT"
+14 DO ^%ZTLOAD
+15 GOTO EX
+16 ;
TK1 SET ONCOXD0=0
+1 FOR
SET ONCOXD0=$ORDER(^ONCO(165.5,"C",ONCOXD1,ONCOXD0))
if ONCOXD0'>0
QUIT
IF $$DIV^ONCFUNC(ONCOXD0)=DUZ(2)
Begin DoDot:1
+2 SET (NUMBER,ONCODA)=ONCOXD0
+3 SET IOP=ONCOION
+4 WRITE @IOF
+5 DO @PRINT
+6 IF PRINT["PRT1"
Begin DoDot:2
+7 SET IOP=ONCOION
+8 DO 8^ONCOPMP
End DoDot:2
End DoDot:1
IF $EXTRACT(ONCIOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to go to next abstract or '^' to exit"
DO ^DIR
if 'Y
QUIT
+9 GOTO EX
+10 ;
2 ;[MA Print QA/Multiple Abstracts - 2 All Abstracts, One SITE/GP]
+1 WRITE !
SET DIC("A")=" Select SITE/GP: "
+2 SET DIC="^ONCO(164.2,"
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
GOTO EX
SET ONCOXD1=+Y
+3 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+4 SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOOUT=""
GOTO EX
+5 SET ONCOION=ION
SET ONCIOST=IOST
+6 IF '$DATA(IO("Q"))
DO TK2^ONCOPMA
GOTO EX
+7 SET ZTRTN="TK2^ONCOPMA"
+8 SET ZTSAVE("ONCOXD1")=""
+9 SET ZTSAVE("ONCOION")=""
+10 SET ZTSAVE("ONCIOST")=""
+11 SET ZTSAVE("PRINT")=""
+12 SET ZTSAVE("ESPD")=""
+13 SET ZTDESC="All Abstracts, One SITE/GP"
+14 DO ^%ZTLOAD
GOTO EX
+15 ;
TK2 SET ONCOXD0=0
+1 FOR
SET ONCOXD0=$ORDER(^ONCO(165.5,"B",ONCOXD1,ONCOXD0))
if ONCOXD0'>0
QUIT
IF $$DIV^ONCFUNC(ONCOXD0)=DUZ(2)
Begin DoDot:1
+2 SET (NUMBER,ONCODA)=ONCOXD0
+3 SET IOP=ONCOION
+4 DO @PRINT
+5 IF PRINT["PRT1"
Begin DoDot:2
+6 SET IOP=ONCOION
+7 DO 8^ONCOPMP
End DoDot:2
End DoDot:1
IF $EXTRACT(ONCIOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to go to next abstract or '^' to exit"
DO ^DIR
if 'Y
QUIT
WRITE @IOF
+8 GOTO EX
+9 ;
3 ;[MA Print QA/Multiple Abstracts - 3 All abstracts, ACCESSION YEAR(s), One SITE/GP]
+1 SET Y=3
DO TF^ONCOST
if Y[U
GOTO EX
+2 SET DIC("A")=" Select SITE/GP: "
+3 SET DIC(0)="AEQZ"
SET DIC="^ONCO(164.2,"
DO ^DIC
if Y<0
GOTO EX
if Y=U
GOTO EX
SET ONCOXD1=+Y
+4 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+5 SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+6 SET ONCOION=ION
SET ONCIOST=IOST
+7 IF '$DATA(IO("Q"))
DO TK3^ONCOPMA
GOTO EX
+8 SET ZTRTN="TK3^ONCOPMA"
+9 SET ZTSAVE("ONCOXD1")=""
+10 SET ZTSAVE("ONCOION")=""
+11 SET ZTSAVE("ONCIOST")=""
+12 SET ZTSAVE("PRINT")=""
+13 SET ZTSAVE("ONCOS*")=""
+14 SET ZTSAVE("ESPD")=""
+15 SET ZTDESC="All abstracts, One or more ACCESSION YEAR(s), One SITE/GP"
+16 DO ^%ZTLOAD
GOTO EX
+17 ;
TK3 NEW ONCOXD0,SY,EY
+1 SET ONCOXD0=0
+2 SET SY=$SELECT(ONCOS("YR")="ALL":0,1:$PIECE(ONCOS("YR"),U,1)-1)
+3 SET EY=$SELECT(ONCOS("YR")="ALL":9999,1:$PIECE(ONCOS("YR"),U,2))
+4 FOR
SET SY=$ORDER(^ONCO(165.5,"AY",SY))
if (SY'>0)!(SY>EY)!($GET(Y)=0)
QUIT
FOR
SET ONCOXD0=$ORDER(^ONCO(165.5,"AY",SY,ONCOXD0))
if ONCOXD0'>0
QUIT
IF $$DIV^ONCFUNC(ONCOXD0)=DUZ(2)
IF $PIECE(^ONCO(165.5,ONCOXD0,0),U,1)=ONCOXD1
Begin DoDot:1
+5 SET (NUMBER,ONCODA)=ONCOXD0
+6 SET IOP=ONCOION
+7 DO @PRINT
+8 IF $EXTRACT(ONCIOST,1,2)="C-"
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to go to next abstract or '^' to exit"
+9 IF PRINT["PRT1"
Begin DoDot:2
+10 SET IOP=ONCOION
+11 DO 8^ONCOPMP
End DoDot:2
End DoDot:1
IF $EXTRACT(ONCIOST,1,2)="C-"
WRITE !
DO ^DIR
if 'Y
QUIT
WRITE @IOF
+12 GOTO EX
+13 ;
EX ;KILL variables
+1 KILL ^TMP("ONCO",$JOB)
+2 KILL %ZIS,DIC,DIR,IOP,NUMBER,ONCIOST,ONCODA,ONCOION,ONCOOUT,ONCOS,ONCOUT
+3 KILL ONCOXD0,ONCOXD1,POP,PRINT,ZTDESC,ZTRTN,ZTSAVE
+4 DO ^%ZISC
+5 QUIT
+6 ;
CLEANUP ;Cleanup
+1 KILL Y
