97 lines
3.8 KiB
Mathematica
97 lines
3.8 KiB
Mathematica
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
|