source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPRT.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1ONCOPRT ;Hines OIFO/GWB - Oncology reports ;05/05/00
2 ;;2.11;ONCOLOGY;**24,25,26,27,36**;Mar 07, 1995
3 ;This routine invokes Integration Agreement #3151
4 ;
5 ;[SUS *..Casefinding/Suspense ...]
6SUS ;[SP Print Suspense List by Suspense Date (132c)]
7 S BY="@75,INTERNAL(#3),75,.01,75,2;S1"
8 S (FR,TO)=DUZ(2)_",?"
9 S FLDS="[ONCO SUSPENSE]"
10 G PRT60
11 ;
12DI ;[DI Disease Index]
13 ;This option invokes Integration Agreement #3151
14 S OSPIEN=$O(^ONCO(160.1,"C",DUZ(2),0))
15 S AFLDIV=""
16 I $O(^ONCO(160.1,OSPIEN,6,0)) D
17 .S ADIEN=0 F S ADIEN=$O(^ONCO(160.1,OSPIEN,6,ADIEN)) Q:ADIEN'>0 S AFLDIV=AFLDIV_^ONCO(160.1,OSPIEN,6,ADIEN,0)_U
18 S DIC="^AUPNVPOV(",L=0
19 S BY="[ONC DISEASE INDEX]"
20 S FLDS="[ONC DISEASE INDEX]"
21 S DIS(0)="I $$DIDIV^ONCFUNC(D0)=""Y"""
22 D EN1^DIP
23 K AFLDIV,ADIEN,OSPIEN
24 G EX
25 ;
26STD ;[TD Print Suspense List by Month/Terminal Digit (132c)]
27 S BY="@75,INTERNAL(#3),#75,+12;S1;C27,@TERMINAL DIGIT;S1"
28 S (FR,TO)=DUZ(2)_",?,?"
29 S FLDS="[ONCO SUSPENSE]",DHD="[ONCO SUSPENSE/TERMDIG-HDR]"
30 G PRT60
31 ;
32SAT ;[CS Print Complete Suspense List by Term Digit (132c)]
33 S BY="@75,INTERNAL(#3),75,.01,@TERMINAL DIGIT;S1"
34 S (FR,TO)=DUZ(2)
35 S FLDS="[ONCO SUSPENSE]",DHD="[ONCO SUSPENSE-ALL/TERMDIG-HDR]"
36 W !!?10,"This option produces a list for requesting all charts"
37 W !?10,"that are currently in suspense.",!
38 G PRT60
39 ;
40DNP ;[NP Oncology Patient List-NO Primaries/Suspense]
41 S BY="@75,INTERNAL(#3),@NO PRIMARY;L1,NAME"
42 S (FR,TO)=DUZ(2)
43 S FLDS="[ONCO PATIENT ONLY]"
44 G PRT60
45 ;
46 ;[ABS *..Abstracting/Printing ...]
47ABI ;[NC Print Abstract NOT Complete List]
48 S BY="[ONCO ABSTRACT NOT-COMPLETE]"
49 G PRT655
50 ;
51 ;[FOL *..Follow-up Functions ...]
52PFH ;[FH Patient Follow-up History]
53 D PAT I Y'<0 D G EX
54 .S BY="@NUMBER"
55 .S (FR,TO)=+Y
56 .S FLDS="[ONCO FOLLOWUP HISTORY]"
57 .D PRT60
58 Q
59 ;
60DAD ;[FA Print Due Follow-up/Admission List]
61 W ! S (BY,FLDS)="[ONCO DUE FOLLOWUP-ADM/DIS]"
62 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
63 G PRT60
64 ;
65DUF ;[DF Print Due Follow-up List by Month Due]
66 W ! S (BY,FLDS)="[ONCO DUE FOLLOWUP]"
67 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
68 G PRT60
69 ;
70DTD ;[TD Print Due Follow-up List by 'Terminal Digit']
71 W ! S (BY,FLDS)="[ONCO DUE FOLLOWUP/TERMDIG]"
72 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
73 G PRT60
74 ;
75DEL ;[LF Print Delinquent (LTF) List]
76 W !!?5,"The FOLLOW-UP STATUS will be changed from ACTIVE to (LTF)."
77 W !?5,"After 15 months the patient is considered LOST TO FOLLOW-UP."
78 W !! S (BY,FLDS)="[ONCO DELINQUENT(LTF) LIST]"
79 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
80 G PRT60
81 ;
82FST ;[SR Follow-up Status Report by Patient (132c)]
83 W ! S (BY,FLDS)="[ONCO FOLLOWUP STATUS RPT]"
84 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
85 G PRT60
86 ;
87 ;[FP Follow-up Procedures Menu ...]
88PFR ;[FR Individual Follow-up Report]
89 D PAT I Y'<0 D G EX
90 .S BY="@NUMBER"
91 .S (FR,TO)=+Y
92 .S FLDS="[ONCO FOLLOWUP PATIENT RPT]"
93 .D PRT60
94 Q
95 ;
96ACOS80 ;[AA Accession Register-ACOS (80c)]
97 S (BY,FLDS)="[ONCO ACCREG-ACOS80]" D HA G PRT655
98 ;
99AC80ST ;[AS Accession Register-Site (80c)]
100 S (BY,FLDS)="[ONCO ACCREG-SITE/GP80]" D HA G PRT655
101 ;
102EOAC ;[AE Accession Register-EOVA (132c)]
103 S (BY,FLDS)="[ONCO ACCREG-EOVA132]" D HA G PRT655
104 ;
105HA ;Help for Accession Registers
106 W !!?3,"For a complete register:"
107 W !?5,"START WITH ACC/SEQ NUMBER: FIRST// <Enter>"
108 W !!?3,"For a single accession year (e.g. 1999):"
109 W !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00000"
110 W !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-99999"
111 W !!?3,"For a single patient (e.g. 1999-00001):"
112 W !,?5,"START WITH ACC/SEQ NUMBER: FIRST// 1999-00001/00"
113 W !,?5,"GO TO ACC/SEQ NUMBER: LAST// 1999-00001/99"
114 W !
115 Q
116 ;
117ACOSPT ;[PA Patient Index-ACOS (132c)]
118 S BY="NAME",(FR,TO)=""
119 S FLDS="[ONCO PATIENT INDX-ACOS]"
120 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
121 G PRT60
122 ;
123PAT80 ;[PS Patient Index-Site (80c)]
124 S BY="NAME"
125 S (FR,TO)=""
126 S FLDS="[ONCO PATIENT INDX80]"
127 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
128 G PRT60
129 ;
130EOVA ;[PE Patient Index-EOVA (132c)]
131 S BY="NAME"
132 S (FR,TO)=""
133 S FLDS="[ONCO PATIENT INDX-EOVA132]"
134 S DIS(0)="I $$PFTD^ONCFUNC(D0)=""Y"""
135 G PRT60
136 ;
137ICD80 ;[IN Primary ICDO Listing (80c)]
138 S (BY,FLDS)="[ONCO ICDO-SITE80]"
139 G PRT655
140 ;
141SIT80 ;[SG Primary Site/GP Listing (80c)]
142 S (BY,FLDS)="[ONCO SITE/GP80]"
143 G PRT655
144 ;
145ICD132 ;[IW Primary ICDO Listing (132c)]
146 S (BY,FLDS)="[ONCO ICDO-SITE132]"
147 G PRT655
148 ;
149PAT ;ONCOLOGY PATIENT (160) lookup
150 W !
151 S DIC="^ONCO(160,",DIC(0)="AEQM",DIC("A")=" Select Patient Name: "
152 D ^DIC K DIC W !
153 Q
154 ;
155PRT60 ;Print ONCOLOGY PATIENT (160) file
156 S DIC="^ONCO(160,",L=0 D EN1^DIP G EX
157 ;
158PRT655 ;Print ONCOLOGY PRIMARY (165.5) file
159 S DIC="^ONCO(165.5,",L=0 D EN1^DIP G EX
160 ;
161EX K DIC,DIS,BY,FR,TO,FLDS,L,Y
162 Q
Note: See TracBrowser for help on using the repository browser.