- 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 Apr 23, 2025@18:39:54 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
