VistA-FOIAVistA/r/ONCOLOGY-ONC/ONCOPMB.m

118 lines
4.0 KiB
Mathematica
Raw Normal View History

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