VistA-WorldVistAEHR/r/ONCOLOGY-ONC/ONCOUTC.m

97 lines
3.8 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
ONCOUTC ;Hines OIFO/GWB - [UTL *..Utility Options ...] ;02/04/00
;;2.11;ONCOLOGY;**5,24,25,47**;Mar 07, 1995;Build 19
;
INQ ;[PI Patient/Primary Inquiry]
D PAT G EX:Y<0
I $$PFTD^ONCFUNC(ONCOD0)="N" D G INQ
.W !!?5,ONCONM," has no primaries for division: ",DUZ(2)
D SDD^ONCOCOM G INQ
;
DUMP ;[RD Print Oncology Patient Record]
W !,?5,"This option will display the entire Oncology Record from"
W !?5,"both the ONCOLOGY PATIENT and the ONCOLOGY PRIMARY files",!!
SEL S DIC(0)="AEQZ",DIC="^ONCO(160," D ^DIC G EX:Y<0 S ONCODA=+Y
K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
I '$D(IO("Q")) D DIQ W !!! G SEL
S ZTRTN="DIQ^ONCOUTC",ZTSAVE("ONCODA")="",ZTSAVE("DUZ(2)")=""
S ZTDESC="ONCOLOGY PATIENT RECORD"
D ^%ZTLOAD G EX
DIQ ;Inquire to ONCOLOGY PATIENT (#160) and ONCOLOGY PRIMARY (#165.5) files
U IO W @IOF,!!?5,"*** Information from ONCOLOGY PATIENT file ***",!!
S DA=ONCODA,DIC="^ONCO(160,",DIQ(0)="C" D EN^DIQ
W !!!?5,"*** Information from ONCOLOGY PRIMARY file ***",!!
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
W !!,?5,"*** END of RECORD ***",!! D ^%ZISC
Q
;
EN2 ;[DP Delete Oncology Patient]
D PAT G EX:Y<0
I $D(^ONCO(165.5,"C",ONCOD0)) D SDD^ONCOCOM
W !?5,"Deleting a patient will also delete any primaries associated"
W !?5,"with your division."
S DIR("A")=" Are your sure you want to delete this ONCOLOGY PATIENT"
S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR G EX:Y=U!(Y=""),EN2:'Y
W !
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
I $D(^ONCO(165.5,"C",ONCOD0)) D G EN2
.S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,0))
.S ONCDIV=$P($G(^ONCO(165.5,ONCOP0,"DIV")),U,1)
.W !?5,"Unable to delete ONCOLOGY PATIENT."
.W !?5,"This patient has primaries which belong to division: ",ONCDIV,!
S DA=ONCOD0,DIK="^ONCO(160,"
W !!?5,"Deleting ONCOLOGY PATIENT..." D ^DIK G EN2
;
EN3 ;[DS Delete Primary Site/GP Record]
D PAT G EX:Y<0
S UTL="DELETE" D PRIM G EN3:Y<0
S ONCOSIT=$P(Y,U,2),ONCOP0=+Y
W !!?5,ONCONM,?35,$P(^ONCO(164.2,ONCOSIT,0),U),!!
S DIR("A")=" Are you sure you want to delete this primary"
S DIR("B")="NO",DIR(0)="Y" D ^DIR G EX:(Y="")!(Y=U),EN3:Y=0
D DP G EN3
;
EN1 ;[EA Edit Site/AccSeq# Data]
D PAT G EX:Y<0
SP S UTL="EDIT" D PRIM G:Y'>0 EN1 D DIE1
S DIR("A")="Data OK",DIR("B")="Y",DIR(0)="Y"
D ^DIR Q:Y=U!(Y="") G:Y=0 SP G EN1
;
PRIM ;Select ONCOLOGY PRIMARY (#165.5)
I $$PFTD^ONCFUNC(ONCOD0)="N" D S Y=-1 Q
.W !!?5,ONCONM," has no primaries for division: ",DUZ(2)
S D0=ONCOD0 D SDD^ONCOCOM W !?5,"Select primary to ",UTL,!
S D="C",DIC="^ONCO(165.5,",DIC(0)="EZ",X=ONCOD0 D IX^DIC Q:(Y<0)!(Y=U)
Q
;
DIE1 ;Edit ONCOLOGY PRIMARY (#165.5)
S (D0,ONCODP0,DA)=+Y,DR="[ONCO UTL CORRECT DATA]",DIE="^ONCO(165.5,"
S ONCOL=0
L +^ONCO(165.5,ONCODP0):0 I $T D ^DIE L -^ONCO(165.5,ONCODP0) S ONCOL=1
I 'ONCOL W !,"Record being edited by another user." G PRIM
S Y=0 K ONCOL
S ONCOD0P=D0
S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
I ABSTAT=3 D CHANGE^ONCGENED
Q
;
PAT ;Select ONCOLOGY PATIENT (#160)
W ! S DIC="^ONCO(160,",DIC(0)="AEZM" D ^DIC K DIC Q:Y<0
S (ONCOD0,D0)=+Y,ONCONM=Y(0,0)
N Y K DIQ,ONC S DIC="^ONCO(160,",DR="2;3;8;10",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
W ?35,"Race.........: ",ONC(160,ONCOD0,8)
W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
Q
;
DP ;Delete ONCOLOGY PRIMARY (#165.5)
W !?5,"Deleting ONCOLOGY PRIMARY: ",$$GET1^DIQ(165.5,ONCOP0,20)
S DA=ONCOP0,DIK="^ONCO(165.5," D ^DIK S D0=ONCOD0 H 2 W !
Q
;
EX ;Kill variables and exit
K D,D0,DA,DIC,DIE,DIK,DIQ,DIR,DR,FLDS,L,X,Y
K ONCDIV,ONC,ONCOD0,ONCODA,ONCODP0,ONCONM,ONCOP0,ONCOSIT,ONCOUT,UTL
Q