ONCOPMB ;Hines OIFO/GWB - ONCOPMA continued ;12/14/99
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
Y G @Y ;set from ONCOPMA
4 ;[MA Print QA/Multiple Abstracts - 4 All abstracts, 1 year]
S Y=3 D Y^ONCOST G EX:Y[U
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK4^ONCOPMB G EX
S ZTRTN="TK4^ONCOPMB"
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("ONCOS*")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ESPD")=""
S ZTDESC="ALL ABSTRACTS for 19"_+ONCOS("YR")
D ^%ZTLOAD
G EX
;
TK4 N ONCOYEAR S ONCOXD0=0,ONCOYEAR=+ONCOS("YR")
F S ONCOXD0=$O(^ONCO(165.5,"AY",ONCOYEAR,ONCOXD0)) Q:ONCOXD0'>0 I $$DIV^ONCFUNC(ONCOXD0)=DUZ(2) D I ONCIOST?1"C".E 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
.S DIOBEG="W @IOF"
.D @PRINT
.I PRINT["PRT1" D
..S IOP=ONCOION
..D 8^ONCOPMP
G EX
;
5 ;[MA Print QA/Multiple Abstracts - 5 Abstracts by DATE DX]
W !
S BDT=$O(^ONCO(165.5,"ADX",0))
S DIR(0)="D^"_BDT_":DT:EX",DIR("A")=" Start, DATE DX" D ^DIR
G EX:Y[U!(Y="")
S ONCOD(1)=Y
S DIR("A")=" End, DATE DX" D ^DIR
G EX:Y[U
S ONCOD(2)=Y
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK5^ONCOPMB G EX
S ZTRTN="TK5^ONCOPMB"
S ZTSAVE("ONCOD*")=""
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ESPD")=""
S ZTDESC="ABSTRACTS BY DXDT"
D ^%ZTLOAD
G EX
;
TK5 S XDT=ONCOD(1)-1
S OUT=1
F S XDT=$O(^ONCO(165.5,"ADX",XDT)) Q:XDT="" Q:XDT>ONCOD(2) D G:'OUT EX
.S PIEN=0
.F S PIEN=$O(^ONCO(165.5,"ADX",XDT,PIEN)) Q:PIEN="" I $$DIV^ONCFUNC(PIEN)=DUZ(2),$P($G(^ONCO(165.5,PIEN,7)),U,2)=3 D I ONCIOST?1"C".E W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to go to next abstract or '^' to exit" D ^DIR S OUT=Y Q:'OUT
..S (NUMBER,ONCODA)=PIEN
..S IOP=ONCOION
..D @PRINT
..I PRINT["PRT1" D
...S IOP=ONCOION
...D 8^ONCOPMP
G EX
;
6 ;[MA Print QA/Multiple Abstracts - 6 QA-10% Completed abstracts]
I '$D(^ONCO(160.1,"AD")) W !!?10,"Define an AUTHORIZED QA USER in the ONCOLOGY SITE PARAMETERS file" G EX
I '$D(^ONCO(160.1,"AD",DUZ)) W !!?10,"Not an AUTHORIZED QA USER" G EX
I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
W !
S BDT=$O(^ONCO(165.5,"AAD",0))
S DIR(0)="D^"_BDT_":DT:EX",DIR("A")=" Start, DATE CASE COMPLETED" D ^DIR
G EX:Y[U!(Y="")
S ONCOD(1)=Y
S DIR("A")=" End, DATE CASE COMPLETED" D ^DIR
G EX:Y[U!(Y="")
S ONCOD(2)=Y
K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
S ONCOION=ION,ONCIOST=IOST
I '$D(IO("Q")) D TK6^ONCOPMB G EX
S ZTRTN="TK6^ONCOPMB"
S ZTSAVE("ONCOD*")=""
S ZTSAVE("ONCOION")=""
S ZTSAVE("ONCIOST")=""
S ZTSAVE("PRINT")=""
S ZTSAVE("ESPD")=""
S ZTDESC="ABSTRACTS BY DXDT"
D ^%ZTLOAD
G EX
;
TK6 K ^TMP("ONCO",$J) S T=0,XDT=ONCOD(1)
F S XDT=$O(^ONCO(165.5,"AAD",XDT)) Q:XDT="" Q:XDT>ONCOD(2) D
.S XD0=0 F S XD0=$O(^ONCO(165.5,"AAD",XDT,XD0)) Q:XD0'>0 I $$DIV^ONCFUNC(XD0)=DUZ(2),$P($G(^ONCO(165.5,XD0,0)),U,4)<10 S N7=$G(^ONCO(165.5,XD0,7)) I $P(N7,U,2)=3 D
..S QA=+$P(N7,U,4) I QA="Y",$P(N7,U,9)'="" Q
..S T=T+1,^TMP("ONCO",$J,T)=XD0,ONCO(T)=XD0 Q
G EX:T=0 S QA=(.1*T) I QA["." S QA=$J(QA,$L(QA)-2,0)
G EX:QA=0
S ONCOQA=QA,ONCOTT=T,ONCOST=$P(^ONCO(160.1,0),U,3)
K ^(ONCOST,"QA")
S ^ONCO(160.1,ONCOST,"QA")=ONCOD(1)_U_ONCOD(2)
F ONCOQ=1:1 D Q:ONCOQ=ONCOQA I ONCIOST?1"C".E W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to go to next abstract or '^' to exit" D ^DIR Q:'Y
.S XDN=$R(ONCOTT+1)
.I XDN D
..S (NUMBER,ONCODA)=^TMP("ONCO",$J,XDN)
..S XD0=$P(^ONCO(165.5,ONCODA,0),U,2),IOP=ONCOION
..S $P(^ONCO(165.5,ONCODA,7),U,4)="Y"
..D PID^ONCOCOM,@PRINT
..S ^ONCO(160.1,ONCOST,"QA",ONCOQ)=ONCOPID
..S $P(^ONCO(160.1,ONCOST,"QA"),U,3)=ONCOTT,IOP=ONCOION
..D 8^ONCOPMP
;
EX ;EXIT
K ONCOION,ONCIOST,ONCOD,ONCOXD0,ONCOXD1,ONCOQ,ONCOQA,ONCOTT,ONCOS,ONCOYR
K T,ONCODA,ONCOS,DIOEND,DIC,DIR,FR,TO,BY,L,N7,^TMP("ONCO",$J)
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOPMB 4174 printed Nov 22, 2024@17:35:26 Page 2
ONCOPMB ;Hines OIFO/GWB - ONCOPMA continued ;12/14/99
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
Y ;set from ONCOPMA
GOTO @Y
4 ;[MA Print QA/Multiple Abstracts - 4 All abstracts, 1 year]
+1 SET Y=3
DO Y^ONCOST
if Y[U
GOTO EX
+2 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+3 KILL IO("Q")
SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOOUT=""
GOTO EX
+4 SET ONCOION=ION
SET ONCIOST=IOST
+5 IF '$DATA(IO("Q"))
DO TK4^ONCOPMB
GOTO EX
+6 SET ZTRTN="TK4^ONCOPMB"
+7 SET ZTSAVE("ONCOION")=""
+8 SET ZTSAVE("ONCIOST")=""
+9 SET ZTSAVE("ONCOS*")=""
+10 SET ZTSAVE("PRINT")=""
+11 SET ZTSAVE("ESPD")=""
+12 SET ZTDESC="ALL ABSTRACTS for 19"_+ONCOS("YR")
+13 DO ^%ZTLOAD
+14 GOTO EX
+15 ;
TK4 NEW ONCOYEAR
SET ONCOXD0=0
SET ONCOYEAR=+ONCOS("YR")
+1 FOR
SET ONCOXD0=$ORDER(^ONCO(165.5,"AY",ONCOYEAR,ONCOXD0))
if ONCOXD0'>0
QUIT
IF $$DIV^ONCFUNC(ONCOXD0)=DUZ(2)
Begin DoDot:1
+2 SET (NUMBER,ONCODA)=ONCOXD0
+3 SET IOP=ONCOION
+4 SET DIOBEG="W @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 ONCIOST?1"C".E
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 ;
5 ;[MA Print QA/Multiple Abstracts - 5 Abstracts by DATE DX]
+1 WRITE !
+2 SET BDT=$ORDER(^ONCO(165.5,"ADX",0))
+3 SET DIR(0)="D^"_BDT_":DT:EX"
SET DIR("A")=" Start, DATE DX"
DO ^DIR
+4 if Y[U!(Y="")
GOTO EX
+5 SET ONCOD(1)=Y
+6 SET DIR("A")=" End, DATE DX"
DO ^DIR
+7 if Y[U
GOTO EX
+8 SET ONCOD(2)=Y
+9 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+10 KILL IO("Q")
SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+11 SET ONCOION=ION
SET ONCIOST=IOST
+12 IF '$DATA(IO("Q"))
DO TK5^ONCOPMB
GOTO EX
+13 SET ZTRTN="TK5^ONCOPMB"
+14 SET ZTSAVE("ONCOD*")=""
+15 SET ZTSAVE("ONCOION")=""
+16 SET ZTSAVE("ONCIOST")=""
+17 SET ZTSAVE("PRINT")=""
+18 SET ZTSAVE("ESPD")=""
+19 SET ZTDESC="ABSTRACTS BY DXDT"
+20 DO ^%ZTLOAD
+21 GOTO EX
+22 ;
TK5 SET XDT=ONCOD(1)-1
+1 SET OUT=1
+2 FOR
SET XDT=$ORDER(^ONCO(165.5,"ADX",XDT))
if XDT=""
QUIT
if XDT>ONCOD(2)
QUIT
Begin DoDot:1
+3 SET PIEN=0
+4 FOR
SET PIEN=$ORDER(^ONCO(165.5,"ADX",XDT,PIEN))
if PIEN=""
QUIT
IF $$DIV^ONCFUNC(PIEN)=DUZ(2)
IF $PIECE($GET(^ONCO(165.5,PIEN,7)),U,2)=3
Begin DoDot:2
+5 SET (NUMBER,ONCODA)=PIEN
+6 SET IOP=ONCOION
+7 DO @PRINT
+8 IF PRINT["PRT1"
Begin DoDot:3
+9 SET IOP=ONCOION
+10 DO 8^ONCOPMP
End DoDot:3
End DoDot:2
IF ONCIOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to go to next abstract or '^' to exit"
DO ^DIR
SET OUT=Y
if 'OUT
QUIT
End DoDot:1
if 'OUT
GOTO EX
+11 GOTO EX
+12 ;
6 ;[MA Print QA/Multiple Abstracts - 6 QA-10% Completed abstracts]
+1 IF '$DATA(^ONCO(160.1,"AD"))
WRITE !!?10,"Define an AUTHORIZED QA USER in the ONCOLOGY SITE PARAMETERS file"
GOTO EX
+2 IF '$DATA(^ONCO(160.1,"AD",DUZ))
WRITE !!?10,"Not an AUTHORIZED QA USER"
GOTO EX
+3 IF PRINT["PRT3"
DO ESPD^ONCOGEN
IF ESPD[U
KILL ESPD
QUIT
+4 WRITE !
+5 SET BDT=$ORDER(^ONCO(165.5,"AAD",0))
+6 SET DIR(0)="D^"_BDT_":DT:EX"
SET DIR("A")=" Start, DATE CASE COMPLETED"
DO ^DIR
+7 if Y[U!(Y="")
GOTO EX
+8 SET ONCOD(1)=Y
+9 SET DIR("A")=" End, DATE CASE COMPLETED"
DO ^DIR
+10 if Y[U!(Y="")
GOTO EX
+11 SET ONCOD(2)=Y
+12 KILL IO("Q")
SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO EX
+13 SET ONCOION=ION
SET ONCIOST=IOST
+14 IF '$DATA(IO("Q"))
DO TK6^ONCOPMB
GOTO EX
+15 SET ZTRTN="TK6^ONCOPMB"
+16 SET ZTSAVE("ONCOD*")=""
+17 SET ZTSAVE("ONCOION")=""
+18 SET ZTSAVE("ONCIOST")=""
+19 SET ZTSAVE("PRINT")=""
+20 SET ZTSAVE("ESPD")=""
+21 SET ZTDESC="ABSTRACTS BY DXDT"
+22 DO ^%ZTLOAD
+23 GOTO EX
+24 ;
TK6 KILL ^TMP("ONCO",$JOB)
SET T=0
SET XDT=ONCOD(1)
+1 FOR
SET XDT=$ORDER(^ONCO(165.5,"AAD",XDT))
if XDT=""
QUIT
if XDT>ONCOD(2)
QUIT
Begin DoDot:1
+2 SET XD0=0
FOR
SET XD0=$ORDER(^ONCO(165.5,"AAD",XDT,XD0))
if XD0'>0
QUIT
IF $$DIV^ONCFUNC(XD0)=DUZ(2)
IF $PIECE($GET(^ONCO(165.5,XD0,0)),U,4)<10
SET N7=$GET(^ONCO(165.5,XD0,7))
IF $PIECE(N7,U,2)=3
Begin DoDot:2
+3 SET QA=+$PIECE(N7,U,4)
IF QA="Y"
IF $PIECE(N7,U,9)'=""
QUIT
+4 SET T=T+1
SET ^TMP("ONCO",$JOB,T)=XD0
SET ONCO(T)=XD0
QUIT
End DoDot:2
End DoDot:1
+5 if T=0
GOTO EX
SET QA=(.1*T)
IF QA["."
SET QA=$JUSTIFY(QA,$LENGTH(QA)-2,0)
+6 if QA=0
GOTO EX
+7 SET ONCOQA=QA
SET ONCOTT=T
SET ONCOST=$PIECE(^ONCO(160.1,0),U,3)
+8 KILL ^(ONCOST,"QA")
+9 SET ^ONCO(160.1,ONCOST,"QA")=ONCOD(1)_U_ONCOD(2)
+10 FOR ONCOQ=1:1
Begin DoDot:1
+11 SET XDN=$RANDOM(ONCOTT+1)
+12 IF XDN
Begin DoDot:2
+13 SET (NUMBER,ONCODA)=^TMP("ONCO",$JOB,XDN)
+14 SET XD0=$PIECE(^ONCO(165.5,ONCODA,0),U,2)
SET IOP=ONCOION
+15 SET $PIECE(^ONCO(165.5,ONCODA,7),U,4)="Y"
+16 DO PID^ONCOCOM
DO @PRINT
+17 SET ^ONCO(160.1,ONCOST,"QA",ONCOQ)=ONCOPID
+18 SET $PIECE(^ONCO(160.1,ONCOST,"QA"),U,3)=ONCOTT
SET IOP=ONCOION
+19 DO 8^ONCOPMP
End DoDot:2
End DoDot:1
if ONCOQ=ONCOQA
QUIT
IF ONCIOST?1"C".E
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
+20 ;
EX ;EXIT
+1 KILL ONCOION,ONCIOST,ONCOD,ONCOXD0,ONCOXD1,ONCOQ,ONCOQA,ONCOTT,ONCOS,ONCOYR
+2 KILL T,ONCODA,ONCOS,DIOEND,DIC,DIR,FR,TO,BY,L,N7,^TMP("ONCO",$JOB)
+3 DO ^%ZISC
+4 QUIT
