1 | ONCOAIF ;Hines OIFO/GWB - POST FOLLOW-UP; 07/12/00
|
---|
2 | ;;2.11;ONCOLOGY;**11,15,16,24,25,26,27,28,37,45,47**;Mar 07, 1995;Build 19
|
---|
3 | ;
|
---|
4 | BEG W @IOF,!," Post/Edit Follow-up"
|
---|
5 | W !," -------------------",!
|
---|
6 | Q
|
---|
7 | ;
|
---|
8 | PAT ;[PF Post/Edit Follow-up]
|
---|
9 | N ONCDUZ,ONCDT
|
---|
10 | S ONCDUZ=DUZ,ONCDT=DT
|
---|
11 | D BEG
|
---|
12 | S DIC("A")=" Post/Edit Follow-Up for patient: "
|
---|
13 | S DIC="^ONCO(160,",DIC(0)="AEMQZ" D ^DIC K DIC
|
---|
14 | G EX:Y<0
|
---|
15 | S (ONCOD0,DA,D0)=+Y,ONCONM=Y(0,0)
|
---|
16 | D SUM,LST^ONCODLF G DIE
|
---|
17 | ;
|
---|
18 | LST ;Follow-Up
|
---|
19 | W @IOF,!!," **********FOLLOW-UP**********",!!
|
---|
20 | W " Patient: ",ONCONM
|
---|
21 | W:$D(XDD) !," Date of Inpatient Discharge: ",XDD
|
---|
22 | Q
|
---|
23 | ;
|
---|
24 | EN ;FOLLOW-UP entry when patient has been pre-selected
|
---|
25 | K F,DIC,DO,ONCOD1,LC,VS,NF,XDT,XDD,XR
|
---|
26 | S ONCDUZ=DUZ,ONCDT=DT
|
---|
27 | S PRESEL=1
|
---|
28 | S XDT=$S('$D(ONCOD0P):"",1:$$GET1^DIQ(165.5,ONCOD0P,1.1,"I"))
|
---|
29 | I (XDT="")!(XDT="0000000")!(XDT="9999999") D LST G DIE
|
---|
30 | D DD S F=$P($G(^ONCO(160,ONCOD0,"F",0)),U,4)
|
---|
31 | I F<1 D DLC,LST S F=1 G DIE
|
---|
32 | RF S D0=ONCOD0 W !! K DXS,DIOT D BEG W ! D LST^ONCODLF G DIE
|
---|
33 | ;
|
---|
34 | DIE K DXS S ONCOSTAT=1,DA=ONCOD0,DR="[ONCO FOLLOWUP]",DIE="^ONCO(160,",FG=0
|
---|
35 | W ! D ^DIE
|
---|
36 | I 'FG S ONCOVS="" D UPOUT,CHKCMP I $G(FOLINP)="YES" G DIE
|
---|
37 | I $O(^ONCO(160,ONCOD0,"F",0))="" Q
|
---|
38 | D CHKCHG
|
---|
39 | I 'FG Q
|
---|
40 | ;
|
---|
41 | UPDAT S D0=ONCOD0 K DXS,DIOT W ! D LST^ONCODLF,UPD^ONCOCRF
|
---|
42 | N Y K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
|
---|
43 | D EN^DIQ1 W !
|
---|
44 | W !," Name..: ",ONC(160,ONCOD0,.01)
|
---|
45 | W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
|
---|
46 | W !," Status: ",ONC(160,ONCOD0,15)
|
---|
47 | W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
|
---|
48 | D SUM
|
---|
49 | C K DIR S DIR("A")="DATA OK",DIR("B")="Yes",DIR(0)="Y"
|
---|
50 | D ^DIR Q:(Y=U)!(Y="") G DIE:'Y
|
---|
51 | I ONCOVS G EX:$D(PRESEL) G PAT:'$D(REC),REC
|
---|
52 | W !! D DEAD^ONCOFDP
|
---|
53 | Q:$D(ONCOAI) G REC:$D(REC) D KIL K ONCONM S ONCOD=1 G PAT:'$D(QA) Q
|
---|
54 | ;
|
---|
55 | UPOUT ;Uparrow out check before deleting
|
---|
56 | Q:'$D(ONCOD1)
|
---|
57 | Q:'$D(^ONCO(160,ONCOD0,"F",ONCOD1,0))
|
---|
58 | Q:$P(^(0),U,8)=1
|
---|
59 | D DEL
|
---|
60 | Q
|
---|
61 | ;
|
---|
62 | DEL ;Delete FOLLOW-UP entry
|
---|
63 | S DA(1)=ONCOD0,DA=ONCOD1,DIK="^ONCO(160,"_DA(1)_",""F"","
|
---|
64 | D ^DIK S ONCOVS=""
|
---|
65 | W:$D(^ONCO(160,ONCOD0,"F",ONCOD1,0)) $P(^(0),U,8)
|
---|
66 | W !!," *********************ENTRY DELETED*************************"
|
---|
67 | W !!," You have not entered all of the required information."
|
---|
68 | W !!,"(Last Tumor Status(es) have been reset for this patient's primary site(s).)",!!
|
---|
69 | H 1
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | CHKCMP ;Check for 'Complete" abstracts with no follow-up
|
---|
73 | K ASTAT,FOLINP
|
---|
74 | Q:$O(^ONCO(160,ONCOD0,"F",0))'=""
|
---|
75 | S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
|
---|
76 | .I $P($G(^ONCO(165.5,PRIM,7)),U,2)=3 S ASTAT(PRIM)=""
|
---|
77 | Q:'$D(ASTAT)
|
---|
78 | W !
|
---|
79 | W !," There is no follow-up information for this patient."
|
---|
80 | W !," This patient has a 'Complete' abstract."
|
---|
81 | W !," A 'Complete' abstract requires at least one follow-up."
|
---|
82 | W !
|
---|
83 | K DIR
|
---|
84 | S DIR("A")=" Do you wish to enter a follow-up at this time"
|
---|
85 | S DIR("B")="YES",DIR(0)="Y" D ^DIR
|
---|
86 | I Y=1 S FOLINP="YES" Q
|
---|
87 | S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
|
---|
88 | .S DIE="^ONCO(165.5,"
|
---|
89 | .S DA=PRIM
|
---|
90 | .S DR="90///@;91///0;92///@;197///@"
|
---|
91 | .D ^DIE
|
---|
92 | W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)"
|
---|
93 | W !," for the following abstracts:",!
|
---|
94 | S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
|
---|
95 | .S PN=$$GET1^DIQ(165.5,PRIM,.02)
|
---|
96 | .S AN=$$GET1^DIQ(165.5,PRIM,.05)
|
---|
97 | .S SEQ=$$GET1^DIQ(165.5,PRIM,.06)
|
---|
98 | .S PID=$$GET1^DIQ(165.5,PRIM,61)
|
---|
99 | .S PSCODE=$$GET1^DIQ(165.5,PRIM,20.1)
|
---|
100 | .W !?1,PID," ",PSCODE," ",AN,"/",SEQ
|
---|
101 | .W !
|
---|
102 | K DIR S DIR(0)="E" D ^DIR
|
---|
103 | Q
|
---|
104 | ;
|
---|
105 | CHKCHG ;Check for checksum changes to 'Complete' abstracts
|
---|
106 | S CNT=0 W !!," Checking for changes to 'Complete' abstracts" S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
|
---|
107 | .W "."
|
---|
108 | .I $P($G(^ONCO(165.5,PRIM,7)),U,2)=3 D
|
---|
109 | ..S EDITS="NO" S D0=PRIM D NAACCR^ONCGENED K EDITS
|
---|
110 | ..S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
|
---|
111 | ..I CHECKSUM'=$P($G(^ONCO(165.5,PRIM,"EDITS")),U,1) D
|
---|
112 | ...S $P(^ONCO(165.5,PRIM,"EDITS"),U,1)=CHECKSUM
|
---|
113 | ...W !!," Re-computing checksum value for 'Complete' abstract ",$$GET1^DIQ(165.5,PRIM,.061)
|
---|
114 | ...S CNT=CNT+1
|
---|
115 | W:CNT=0 " No changes found."
|
---|
116 | Q
|
---|
117 | ;
|
---|
118 | REC ;[RF Recurrence/Sub Tx Follow-up]
|
---|
119 | K ^DISV(DUZ,"^ONCO(165.5,")
|
---|
120 | N ONCDUZ,ONCDT
|
---|
121 | S ONCDUZ=DUZ,ONCDT=DT
|
---|
122 | S XR=1,REC="" W @IOF,!," Recurrence/Sub Tx Follow-up"
|
---|
123 | W !," ---------------------------",!
|
---|
124 | S DIC("A")="Select Patient for Recurrence: "
|
---|
125 | S DIC="^ONCO(160,",DIC(0)="AEQMZ" D ^DIC K DIC
|
---|
126 | G EX:Y<0
|
---|
127 | S (D0,ONCOD0)=+Y,ONCONM=Y(0,0)
|
---|
128 | N Y
|
---|
129 | K DIQ,ONC S DIC="^ONCO(160,",DR=".01;2;3;8;10;15",DA=ONCOD0,DIQ="ONC"
|
---|
130 | D EN^DIQ1 W !
|
---|
131 | W !?2,"Name.........: ",ONC(160,ONCOD0,.01)
|
---|
132 | W ?35,"Race.........: ",ONC(160,ONCOD0,8)
|
---|
133 | W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
|
---|
134 | W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
|
---|
135 | W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
|
---|
136 | W ?35,"Status.......: ",ONC(160,ONCOD0,15)
|
---|
137 | D SUM
|
---|
138 | K DIC W !?1,"Select Primary for Recurrence: ",!
|
---|
139 | S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ" D IX^DIC G:Y<0 REC
|
---|
140 | I Y'=" " S (ONCOD0P,DA)=+Y,DR="[ONCO RECURRENCE FOLLOWUP]",DIE="^ONCO(165.5,",DATEDX=$P(^ONCO(165.5,DA,0),U,16),TX=$P($G(^ONCO(165.5,DA,2)),U,1) D ^DIE D CHKCHG S AB=2,ONCOD0P=D0 G EN
|
---|
141 | ;
|
---|
142 | RE ;Recurrence
|
---|
143 | W !!," Recurrence"
|
---|
144 | W !," ----------"
|
---|
145 | Q
|
---|
146 | ;
|
---|
147 | STX ;Subsequent Course of Treatment
|
---|
148 | W !!," Subsequent Course of Treatment"
|
---|
149 | W !," ------------------------------"
|
---|
150 | Q
|
---|
151 | ;
|
---|
152 | KIL ;Kill variables
|
---|
153 | K ONCOSTAT,XR,ED0,DA,DIC,DIE,DIK,DIOT,DIR,DO,DR,DQ,DXS,F,FDOC,FG,FS
|
---|
154 | K ONCOD1,ONCOLC,TM,TS,CS,K,I,XY,XX,XDA,XD1,XD0,LC,ONCONF,ONCOVS,REC
|
---|
155 | K AB,DATEDX,PRESEL
|
---|
156 | Q
|
---|
157 | ;
|
---|
158 | EX ;Exit
|
---|
159 | D KIL Q
|
---|
160 | ;
|
---|
161 | DD ;Date format
|
---|
162 | S XDD=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700) Q
|
---|
163 | ;
|
---|
164 | DLC ;Create FOLLOW-UP
|
---|
165 | K DA
|
---|
166 | S DA(1)=ONCOD0,DIC="^ONCO(160,"_DA(1)_","_"""F"""_","
|
---|
167 | S DLAYGO=160,X=XDT,DIC(0)="ZL"
|
---|
168 | I '$D(^ONCO(160,DA(1),"F")) S ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
|
---|
169 | D FILE^DICN S ONCOLC=XDT,DIE=DIC,DR="1////1;2////2;" D ^DIE
|
---|
170 | K DA,DIC,DLAYGO,DIE
|
---|
171 | Q
|
---|
172 | ;
|
---|
173 | SUM ;Primary summary
|
---|
174 | S XD0=D0
|
---|
175 | N J,XD1,LINE W !!
|
---|
176 | S LINE=" ------------- -------------------- ----------------- ---------- ---- -----"
|
---|
177 | S J=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $D(^ONCO(165.5,XD1,0)) S J=J+1 W:J=1 " Acc/Sequence",?15,"Topography",?37,"Last Tumor Status",?56,"Date DX",?68,"Stat",?74,"Div",!,LINE,! D FU^ONCOCOML
|
---|
178 | Q
|
---|