source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOEDC.m@ 1789

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1ONCOEDC ;Hines OIFO/GWB - ABSTRACT STATUS (165.5,91) INPUT TRANSFORM ;8/2/96
2 ;;2.11;ONCOLOGY;**6,7,13,27,36,41,47**;Mar 07,1995;Build 19
3 ;
4CHECK ;Required field check
5 ;CLASS OF CASE = 0,1 or 2
6 ;SEQUENCE NUMBER = 00-59 or 99
7 ;DATE DX > 12/31/95
8 ;
9 I (X=0)!(X=1)!(X=2) Q
10 S PRM=D0
11 S PTN=$P($G(^ONCO(165.5,D0,0)),U,2)
12 S CMPLT=1,NODE0=$G(^ONCO(165.5,D0,0)),ONCTYP="",ONCANL="" K LIST
13 S CC=$P(NODE0,U,4),SQN=$P(NODE0,U,6),DTDX=$P(NODE0,U,16)
14 S ABSTAT=$P($G(^ONCO(165.5,D0,7)),U,2)
15 I CC="" D S ONCTYP="" K X Q
16 .W !
17 .W !?5,"CLASS OF CLASS is blank."
18 .W !?5,"""Required"" field checking requires CLASS OF CASE."
19 .W !
20 I (CC=0)!(CC=1)!(CC=2),(+SQN<60)!(SQN=99),DTDX>2951231 S ONCANL=1 D CHKFLDS
21 I CMPLT=0 S ONCTYP="A" K X Q
22 I CMPLT=1 D
23 .I $G(ONCANL)=1 D
24 ..W !!," All required data fields have been entered."
25 ..W !!," Beginning inter-field edit checks..." Q
26 .W ! D ^ONCEDIT
27 I CMPLT=1 W !," No inter-field edit check warnings.",! D EDITS Q
28 I $G(OVERRIDE)="NO" G QUIT
29 K DIR S DIR(0)="YA"
30 S DIR("A",1)=" This abstract has inter-field WARNINGS."
31 S DIR("A")=" Do you wish to override them and proceed to the EDITS API? "
32 S DIR("B")="No" D ^DIR K DIR
33 I Y=1 S X=3 W ! D EDITS Q
34QUIT K OVERRIDE
35 S ONCTYP="B" W ! S X=ABSTAT Q
36 ;
37CHKFLDS ;Check ONCOLOGY PRIMARY (165.5) and ONCOLOGY PATIENT (160)
38 S ONCFILE=165.5 D F1655^ONCOEDC1
39 S ONCFILE=160 D F160
40 Q
41 ;
42F160 ;ONCOLOGY PATIENT (160)
43 F FDNUM=2,3,7,8,9,10,38,39,43 D
44 .D:$$GET1^DIQ(160,PTN,FDNUM,"I")="" CMPLT
45 Q
46 ;
47CMPLT ;Set CMPLT = 0 and add field to list of fields needed to be filled in.
48 S FLDNAME=$P($G(^DD(ONCFILE,FDNUM,0)),U,1) S FDNUM=""
49 S CMPLT=0,LIST(FLDNAME)=""
50 Q
51 ;
52PRINT ;Display results
53 I $G(ONCTYP)="" Q
54 I ONCTYP="A" D REQ
55 I ONCTYP="B" D INTER
56 W !
57 Q
58 ;
59REQ ;Missing "required" data item list
60 W !," ABSTRACT STATUS may not be set to COMPLETE unless"
61 W !," all ""required"" data items have been entered.",!
62 W !," The following ""required"" data items have not been"
63 W !," entered for this primary:",!
64 S EX="",LINE=$S(IOST?1"C".E:IOSL-2,1:IOSL-6),CNT=0
65 S FN=""
66 F S FN=$O(LIST(FN)),CNT=CNT+1 Q:FN="" W !,?2,FN I CNT>14 D PCHK Q:EX=U
67 Q
68 ;
69INTER ;Interfield edit warnings
70 ;W !?5,"ABSTRACT STATUS may not be set to COMPLETE until all interfield"
71 ;W !?5,"warnings listed above have been cleared."
72 Q
73 ;
74PCHK ;Enter RETURN to continue or '^' to exit:
75 I ($Y'<(LINE-1)) D Q:EX=U W !
76 .W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
77 .W @IOF Q
78 Q
79 ;
80EDITS ;Call to EDITS API
81 W !," Calling EDITS API..."
82 S DCC=$P($G(^ONCO(165.5,D0,7)),U,1)
83 S DCLC=$P($G(^ONCO(165.5,D0,7)),U,21)
84 I DCC="" D
85 .S $P(^ONCO(165.5,PRM,7),U,1)=DT
86 .S ^ONCO(165.5,"AAD",DT,PRM)=""
87 .S $P(^ONCO(165.5,PRM,7),U,3)=DUZ
88 D ^ONCGENED
89 K EDIT
90 I ERRFLG'=0 D Q
91 .I ABSTAT=3 W !!,"EDITS errors were encountered. ABSTRACT STATUS changed to 0 (Incomplete).",!
92 .I ABSTAT'=3 W !!,"EDITS errors were encountered. ABSTRACT STATUS is unchanged.",!
93 .I DCC="" D
94 ..S $P(^ONCO(165.5,D0,7),U,1)=""
95 ..K ^ONCO(165.5,"AAD",DT,PRM)
96 ..S $P(^ONCO(165.5,D0,7),U,3)=""
97 .K DIR S DIR(0)="YA"
98 .S DIR("A")=" Do you wish to return to the Primary Menu Options? "
99 .S DIR("B")="Yes" D ^DIR K DIR
100 .I Y=1 S EDIT="YES"
101 .S X=$S(ABSTAT=3:0,1:ABSTAT)
102 W !," No EDITS errors or warnings."
103 S $P(^ONCO(165.5,D0,7),U,2)=3
104 I DCC'="" D
105 .I DCLC'="" K ^ONCO(165.5,"AAE",DCLC,PRM)
106 .S $P(^ONCO(165.5,PRM,7),U,21)=DT
107 .S ^ONCO(165.5,"AAE",DT,PRM)=""
108 .S $P(^ONCO(165.5,PRM,7),U,22)=DUZ
109 W !
110 W !," ABSTRACT STATUS.......: ",$$GET1^DIQ(165.5,D0,91,"E")
111 W !," DATE CASE COMPLETED...: ",$$GET1^DIQ(165.5,D0,90,"E")
112 W !," ABSTRACTED BY.........: ",$$GET1^DIQ(165.5,D0,92,"E")
113 W !," DATE CASE LAST CHANGED: ",$$GET1^DIQ(165.5,D0,198,"E")
114 W !," CASE LAST CHANGED BY..: ",$$GET1^DIQ(165.5,D0,199,"E")
115 W !
116 S EDITS="NO" D NAACCR^ONCGENED K EDITS
117 D CHKSUM^ONCGENED
118 W ! R "Enter RETURN to continue: ",PAUSE:30
119 Q
Note: See TracBrowser for help on using the repository browser.