source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPMB.m@ 1154

Last change on this file since 1154 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1ONCOPMB ;Himes OIFO/GWB - ONCOPMA continued ;12/14/99
2 ;;2.11;ONCOLOGY;**11,23,25,44,46,47**;Mar 07, 1995;Build 19
3Y G @Y ;set from ONCOPMA
44 ;[MA Print QA/Multiple Abstracts - 4 All abstracts, 1 year]
5 S Y=3 D Y^ONCOST G EX:Y[U
6 I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
7 K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOOUT="" G EX
8 S ONCOION=ION,ONCIOST=IOST
9 I '$D(IO("Q")) D TK4^ONCOPMB G EX
10 S ZTRTN="TK4^ONCOPMB"
11 S ZTSAVE("ONCOION")=""
12 S ZTSAVE("ONCIOST")=""
13 S ZTSAVE("ONCOS*")=""
14 S ZTSAVE("PRINT")=""
15 S ZTSAVE("ESPD")=""
16 S ZTDESC="ALL ABSTRACTS for 19"_+ONCOS("YR")
17 D ^%ZTLOAD
18 G EX
19 ;
20TK4 N ONCOYEAR S ONCOXD0=0,ONCOYEAR=+ONCOS("YR")
21 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
22 .S (NUMBER,ONCODA)=ONCOXD0
23 .S IOP=ONCOION
24 .S DIOBEG="W @IOF"
25 .D @PRINT
26 .I PRINT["PRT1" D
27 ..S IOP=ONCOION
28 ..D 8^ONCOPMP
29 G EX
30 ;
315 ;[MA Print QA/Multiple Abstracts - 5 Abstracts by DATE DX]
32 W !
33 S BDT=$O(^ONCO(165.5,"ADX",0))
34 S DIR(0)="D^"_BDT_":DT:EX",DIR("A")=" Start, DATE DX" D ^DIR
35 G EX:Y[U!(Y="")
36 S ONCOD(1)=Y
37 S DIR("A")=" End, DATE DX" D ^DIR
38 G EX:Y[U
39 S ONCOD(2)=Y
40 I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
41 K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
42 S ONCOION=ION,ONCIOST=IOST
43 I '$D(IO("Q")) D TK5^ONCOPMB G EX
44 S ZTRTN="TK5^ONCOPMB"
45 S ZTSAVE("ONCOD*")=""
46 S ZTSAVE("ONCOION")=""
47 S ZTSAVE("ONCIOST")=""
48 S ZTSAVE("PRINT")=""
49 S ZTSAVE("ESPD")=""
50 S ZTDESC="ABSTRACTS BY DXDT"
51 D ^%ZTLOAD
52 G EX
53 ;
54TK5 S XDT=ONCOD(1)-1
55 S OUT=1
56 F S XDT=$O(^ONCO(165.5,"ADX",XDT)) Q:XDT="" Q:XDT>ONCOD(2) D G:'OUT EX
57 .S PIEN=0
58 .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
59 ..S (NUMBER,ONCODA)=PIEN
60 ..S IOP=ONCOION
61 ..D @PRINT
62 ..I PRINT["PRT1" D
63 ...S IOP=ONCOION
64 ...D 8^ONCOPMP
65 G EX
66 ;
676 ;[MA Print QA/Multiple Abstracts - 6 QA-10% Completed abstracts]
68 I '$D(^ONCO(160.1,"AD")) W !!?10,"Define an AUTHORIZED QA USER in the ONCOLOGY SITE PARAMETERS file" G EX
69 I '$D(^ONCO(160.1,"AD",DUZ)) W !!?10,"Not an AUTHORIZED QA USER" G EX
70 I PRINT["PRT3" D ESPD^ONCOGEN I ESPD[U K ESPD Q
71 W !
72 S BDT=$O(^ONCO(165.5,"AAD",0))
73 S DIR(0)="D^"_BDT_":DT:EX",DIR("A")=" Start, DATE CASE COMPLETED" D ^DIR
74 G EX:Y[U!(Y="")
75 S ONCOD(1)=Y
76 S DIR("A")=" End, DATE CASE COMPLETED" D ^DIR
77 G EX:Y[U!(Y="")
78 S ONCOD(2)=Y
79 K IO("Q") S %ZIS="Q" W ! D ^%ZIS I POP S ONCOUT="" G EX
80 S ONCOION=ION,ONCIOST=IOST
81 I '$D(IO("Q")) D TK6^ONCOPMB G EX
82 S ZTRTN="TK6^ONCOPMB"
83 S ZTSAVE("ONCOD*")=""
84 S ZTSAVE("ONCOION")=""
85 S ZTSAVE("ONCIOST")=""
86 S ZTSAVE("PRINT")=""
87 S ZTSAVE("ESPD")=""
88 S ZTDESC="ABSTRACTS BY DXDT"
89 D ^%ZTLOAD
90 G EX
91 ;
92TK6 K ^TMP("ONCO",$J) S T=0,XDT=ONCOD(1)
93 F S XDT=$O(^ONCO(165.5,"AAD",XDT)) Q:XDT="" Q:XDT>ONCOD(2) D
94 .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
95 ..S QA=+$P(N7,U,4) I QA="Y",$P(N7,U,9)'="" Q
96 ..S T=T+1,^TMP("ONCO",$J,T)=XD0,ONCO(T)=XD0 Q
97 G EX:T=0 S QA=(.1*T) I QA["." S QA=$J(QA,$L(QA)-2,0)
98 G EX:QA=0
99 S ONCOQA=QA,ONCOTT=T,ONCOST=$P(^ONCO(160.1,0),U,3)
100 K ^(ONCOST,"QA")
101 S ^ONCO(160.1,ONCOST,"QA")=ONCOD(1)_U_ONCOD(2)
102 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
103 .S XDN=$R(ONCOTT+1)
104 .I XDN D
105 ..S (NUMBER,ONCODA)=^TMP("ONCO",$J,XDN)
106 ..S XD0=$P(^ONCO(165.5,ONCODA,0),U,2),IOP=ONCOION
107 ..S $P(^ONCO(165.5,ONCODA,7),U,4)="Y"
108 ..D PID^ONCOCOM,@PRINT
109 ..S ^ONCO(160.1,ONCOST,"QA",ONCOQ)=ONCOPID
110 ..S $P(^ONCO(160.1,ONCOST,"QA"),U,3)=ONCOTT,IOP=ONCOION
111 ..D 8^ONCOPMP
112 ;
113EX ;EXIT
114 K ONCOION,ONCIOST,ONCOD,ONCOXD0,ONCOXD1,ONCOQ,ONCOQA,ONCOTT,ONCOS,ONCOYR
115 K T,ONCODA,ONCOS,DIOEND,DIC,DIR,FR,TO,BY,L,N7,^TMP("ONCO",$J)
116 D ^%ZISC
117 Q
Note: See TracBrowser for help on using the repository browser.