source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOPMB.m

ONCOPMB ;Himes OIFO/GWB - ONCOPMA continued ;12/14/99
 ;;2.11;ONCOLOGY;**11,23,25,44,46,47**;Mar 07, 1995;Build 19
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)<3 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