source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOUTC.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1ONCOUTC ;Hines OIFO/GWB - [UTL *..Utility Options ...] ;02/04/00
2 ;;2.11;ONCOLOGY;**5,24,25,47**;Mar 07, 1995;Build 19
3 ;
4INQ ;[PI Patient/Primary Inquiry]
5 D PAT G EX:Y<0
6 I $$PFTD^ONCFUNC(ONCOD0)="N" D G INQ
7 .W !!?5,ONCONM," has no primaries for division: ",DUZ(2)
8 D SDD^ONCOCOM G INQ
9 ;
10DUMP ;[RD Print Oncology Patient Record]
11 W !,?5,"This option will display the entire Oncology Record from"
12 W !?5,"both the ONCOLOGY PATIENT and the ONCOLOGY PRIMARY files",!!
13SEL S DIC(0)="AEQZ",DIC="^ONCO(160," D ^DIC G EX:Y<0 S ONCODA=+Y
14 K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
15 I '$D(IO("Q")) D DIQ W !!! G SEL
16 S ZTRTN="DIQ^ONCOUTC",ZTSAVE("ONCODA")="",ZTSAVE("DUZ(2)")=""
17 S ZTDESC="ONCOLOGY PATIENT RECORD"
18 D ^%ZTLOAD G EX
19DIQ ;Inquire to ONCOLOGY PATIENT (#160) and ONCOLOGY PRIMARY (#165.5) files
20 U IO W @IOF,!!?5,"*** Information from ONCOLOGY PATIENT file ***",!!
21 S DA=ONCODA,DIC="^ONCO(160,",DIQ(0)="C" D EN^DIQ
22 W !!!?5,"*** Information from ONCOLOGY PRIMARY file ***",!!
23 S ONCOD0=DA,ONCODA=0 F S ONCODA=$O(^ONCO(165.5,"C",ONCOD0,ONCODA)) Q:ONCODA="" I $$DIV^ONCFUNC(ONCODA)=DUZ(2) S DA=ONCODA,DIC="^ONCO(165.5,",DIQ(0)="C" D EN^DIQ
24 W !!,?5,"*** END of RECORD ***",!! D ^%ZISC
25 Q
26 ;
27EN2 ;[DP Delete Oncology Patient]
28 D PAT G EX:Y<0
29 I $D(^ONCO(165.5,"C",ONCOD0)) D SDD^ONCOCOM
30 W !?5,"Deleting a patient will also delete any primaries associated"
31 W !?5,"with your division."
32 S DIR("A")=" Are your sure you want to delete this ONCOLOGY PATIENT"
33 S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR G EX:Y=U!(Y=""),EN2:'Y
34 W !
35 I $D(^ONCO(165.5,"C",ONCOD0)) S ONCOP0=0 F S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,ONCOP0)) Q:ONCOP0'>0 I $$DIV^ONCFUNC(ONCOP0)=DUZ(2) D DP
36 I $D(^ONCO(165.5,"C",ONCOD0)) D G EN2
37 .S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,0))
38 .S ONCDIV=$P($G(^ONCO(165.5,ONCOP0,"DIV")),U,1)
39 .W !?5,"Unable to delete ONCOLOGY PATIENT."
40 .W !?5,"This patient has primaries which belong to division: ",ONCDIV,!
41 S DA=ONCOD0,DIK="^ONCO(160,"
42 W !!?5,"Deleting ONCOLOGY PATIENT..." D ^DIK G EN2
43 ;
44EN3 ;[DS Delete Primary Site/GP Record]
45 D PAT G EX:Y<0
46 S UTL="DELETE" D PRIM G EN3:Y<0
47 S ONCOSIT=$P(Y,U,2),ONCOP0=+Y
48 W !!?5,ONCONM,?35,$P(^ONCO(164.2,ONCOSIT,0),U),!!
49 S DIR("A")=" Are you sure you want to delete this primary"
50 S DIR("B")="NO",DIR(0)="Y" D ^DIR G EX:(Y="")!(Y=U),EN3:Y=0
51 D DP G EN3
52 ;
53EN1 ;[EA Edit Site/AccSeq# Data]
54 D PAT G EX:Y<0
55SP S UTL="EDIT" D PRIM G:Y'>0 EN1 D DIE1
56 S DIR("A")="Data OK",DIR("B")="Y",DIR(0)="Y"
57 D ^DIR Q:Y=U!(Y="") G:Y=0 SP G EN1
58 ;
59PRIM ;Select ONCOLOGY PRIMARY (#165.5)
60 I $$PFTD^ONCFUNC(ONCOD0)="N" D S Y=-1 Q
61 .W !!?5,ONCONM," has no primaries for division: ",DUZ(2)
62 S D0=ONCOD0 D SDD^ONCOCOM W !?5,"Select primary to ",UTL,!
63 S D="C",DIC="^ONCO(165.5,",DIC(0)="EZ",X=ONCOD0 D IX^DIC Q:(Y<0)!(Y=U)
64 Q
65 ;
66DIE1 ;Edit ONCOLOGY PRIMARY (#165.5)
67 S (D0,ONCODP0,DA)=+Y,DR="[ONCO UTL CORRECT DATA]",DIE="^ONCO(165.5,"
68 S ONCOL=0
69 L +^ONCO(165.5,ONCODP0):0 I $T D ^DIE L -^ONCO(165.5,ONCODP0) S ONCOL=1
70 I 'ONCOL W !,"Record being edited by another user." G PRIM
71 S Y=0 K ONCOL
72 S ONCOD0P=D0
73 S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
74 I ABSTAT=3 D CHANGE^ONCGENED
75 Q
76 ;
77PAT ;Select ONCOLOGY PATIENT (#160)
78 W ! S DIC="^ONCO(160,",DIC(0)="AEZM" D ^DIC K DIC Q:Y<0
79 S (ONCOD0,D0)=+Y,ONCONM=Y(0,0)
80 N Y K DIQ,ONC S DIC="^ONCO(160,",DR="2;3;8;10",DA=ONCOD0,DIQ="ONC"
81 D EN^DIQ1 W !
82 W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
83 W ?35,"Race.........: ",ONC(160,ONCOD0,8)
84 W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
85 W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
86 Q
87 ;
88DP ;Delete ONCOLOGY PRIMARY (#165.5)
89 W !?5,"Deleting ONCOLOGY PRIMARY: ",$$GET1^DIQ(165.5,ONCOP0,20)
90 S DA=ONCOP0,DIK="^ONCO(165.5," D ^DIK S D0=ONCOD0 H 2 W !
91 Q
92 ;
93EX ;Kill variables and exit
94 K D,D0,DA,DIC,DIE,DIK,DIQ,DIR,DR,FLDS,L,X,Y
95 K ONCDIV,ONC,ONCOD0,ONCODA,ONCODP0,ONCONM,ONCOP0,ONCOSIT,ONCOUT,UTL
96 Q
Note: See TracBrowser for help on using the repository browser.