ONCOUTC ;HINES OIFO/GWB - [UTL *..Utility Options DS, DP, SQ and EA] ;03/17/11
;;2.2;ONCOLOGY;**1,4,18**;Jul 31, 2013;Build 5
;
INQ ;[PI Patient/Primary Inquiry]
;OUT OF ORDER MESSAGE: Marked for deletion
D PAT G EX:Y<0
I $$PFTD^ONCFUNC(ONCOD0)="N" D G INQ
.W !!?5,ONCONM," has no primaries for division: ",$$GET1^DIQ(4,DUZ(2),99)
D SDD^ONCOCOM G INQ
;
DUMP ;[RD Print Oncology Patient Record]
;OUT OF ORDER MESSAGE: Marked for deletion
;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
;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
;K ZTDESC,ZTRTN,ZTSAVE
;D EX
;Q
;
EN2 ;[DP Delete Oncology Patient]
W !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
W ! K DIR S DIR(0)="E" D ^DIR Q
;OUT OF ORDER MESSAGE: Marked for deletion
;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 you 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]
W !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
W ! K DIR S DIR(0)="E" D ^DIR Q
;OUT OF ORDER MESSAGE: Marked for deletion
;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: ",$$GET1^DIQ(4,DUZ(2),99)
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." D EX G PRIM
S Y=0
S ONCOD0P=D0
S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
I ABSTAT=3 S EAFLAG="YES" D CHANGE^ONCGENED
D EX
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
;
DUPSQ ;[SQ Find Duplicate Acc/Seq numbers]
K ONCPRLST S ONCTTLDP=0 W !
S ONCACSQ="" F S ONCACSQ=$O(^ONCO(165.5,"D",ONCACSQ)) Q:ONCACSQ="" D
.S ONCTTL=0,ONCDUPS=""
.F ZZIEN=0:0 S ZZIEN=$O(^ONCO(165.5,"D",ONCACSQ,ZZIEN)) Q:ZZIEN'>0 D
..S ONCTTL=ONCTTL+1,ONCDUPS=ONCDUPS_ZZIEN_"^"
..I ONCTTL>1 D
...I '$D(ONCPRLST(ONCACSQ)) S ONCTTLDP=ONCTTLDP+1
...S ONCPRLST(ONCACSQ)=ONCDUPS
I '$D(ONCPRLST) W !!?8,"No duplicate Accession/Sequence Numbers Found.",! K DIR S DIR(0)="E" D ^DIR Q
W ! D HDR^ONCOCOML
S ONCACSQ="" F S ONCACSQ=$O(ONCPRLST(ONCACSQ)) Q:ONCACSQ="" D W !
.F X=1:1:999 S ONCXD1=$P(ONCPRLST(ONCACSQ),U,X) Q:ONCXD1="" D DIS2^ONCOCOML
W !!?5,"A total of ",ONCTTLDP," Accession/Sequence numbers with duplicates found.",!?5,"You may use the EA 'Edit Site/AccSeq # Data' option to fix duplicates.",! K DIR S DIR(0)="E" D ^DIR Q
K ONCPRLST,ONCTTLDP,ONCTTL,ONCACSQ,ONCDUPS,ZZIEN Q
;
EX ;Kill variables
K %ZIS,ABSTAT,D,D0,DA,DIC,DIE,DIK,DIQ,DIR,DR,EAFLAG,ONC,ONCDIV
K ONCOD0P,ONCODA,ONCODP0,ONCOL,ONCONM,ONCOP0,ONCOSIT,ONCOUT,POP,UTL,X,Y
Q
;
CLEANUP ;Cleanup
K ONCOD0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOUTC 4910 printed Apr 09, 2024@21:29:24 Page 2
ONCOUTC ;HINES OIFO/GWB - [UTL *..Utility Options DS, DP, SQ and EA] ;03/17/11
+1 ;;2.2;ONCOLOGY;**1,4,18**;Jul 31, 2013;Build 5
+2 ;
INQ ;[PI Patient/Primary Inquiry]
+1 ;OUT OF ORDER MESSAGE: Marked for deletion
+2 DO PAT
if Y<0
GOTO EX
+3 IF $$PFTD^ONCFUNC(ONCOD0)="N"
Begin DoDot:1
+4 WRITE !!?5,ONCONM," has no primaries for division: ",$$GET1^DIQ(4,DUZ(2),99)
End DoDot:1
GOTO INQ
+5 DO SDD^ONCOCOM
GOTO INQ
+6 ;
DUMP ;[RD Print Oncology Patient Record]
+1 ;OUT OF ORDER MESSAGE: Marked for deletion
+2 ;W !,?5,"This option will display the entire Oncology Record from"
+3 ;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
+1 ;S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G EX
+2 ;I '$D(IO("Q")) D DIQ W !!! G SEL
+3 ;S ZTRTN="DIQ^ONCOUTC",ZTSAVE("ONCODA")="",ZTSAVE("DUZ(2)")=""
+4 ;S ZTDESC="ONCOLOGY PATIENT RECORD"
+5 ;D ^%ZTLOAD
+6 ;K ZTDESC,ZTRTN,ZTSAVE
+7 ;D EX
+8 ;Q
+9 ;
EN2 ;[DP Delete Oncology Patient]
+1 WRITE !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
+2 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+3 ;OUT OF ORDER MESSAGE: Marked for deletion
+4 ;D PAT G EX:Y<0
+5 ;I $D(^ONCO(165.5,"C",ONCOD0)) D SDD^ONCOCOM
+6 ;W !?5,"Deleting a patient will also delete any primaries associated"
+7 ;W !?5,"with your division."
+8 ;S DIR("A")=" Are you sure you want to delete this ONCOLOGY PATIENT"
+9 ;S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR G EX:Y=U!(Y=""),EN2:'Y
+10 ;W !
+11 ;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
+12 ;I $D(^ONCO(165.5,"C",ONCOD0)) D G EN2
+13 ;.S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,0))
+14 ;.S ONCDIV=$P($G(^ONCO(165.5,ONCOP0,"DIV")),U,1)
+15 ;.W !?5,"Unable to delete ONCOLOGY PATIENT."
+16 ;.W !?5,"This patient has primaries which belong to division: ",ONCDIV,!
+17 ;S DA=ONCOD0,DIK="^ONCO(160,"
+18 ;W !!?5,"Deleting ONCOLOGY PATIENT..." D ^DIK G EN2
+19 ;
EN3 ;[DS Delete Primary Site/GP Record]
+1 WRITE !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
+2 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+3 ;OUT OF ORDER MESSAGE: Marked for deletion
+4 ;D PAT G EX:Y<0
+5 ;S UTL="DELETE" D PRIM G EN3:Y<0
+6 ;S ONCOSIT=$P(Y,U,2),ONCOP0=+Y
+7 ;W !!?5,ONCONM,?35,$P(^ONCO(164.2,ONCOSIT,0),U),!!
+8 ;S DIR("A")=" Are you sure you want to delete this primary"
+9 ;S DIR("B")="NO",DIR(0)="Y" D ^DIR G EX:(Y="")!(Y=U),EN3:Y=0
+10 ;D DP G EN3
+11 ;
EN1 ;[EA Edit Site/AccSeq# Data]
+1 DO PAT
if Y<0
GOTO EX
SP SET UTL="EDIT"
DO PRIM
if Y'>0
GOTO EN1
DO DIE1
+1 SET DIR("A")="Data OK"
SET DIR("B")="Y"
SET DIR(0)="Y"
+2 DO ^DIR
if Y=U!(Y="")
QUIT
if Y=0
GOTO SP
GOTO EN1
+3 ;
PRIM ;Select ONCOLOGY PRIMARY (165.5)
+1 IF $$PFTD^ONCFUNC(ONCOD0)="N"
Begin DoDot:1
+2 WRITE !!?5,ONCONM," has no primaries for division: ",$$GET1^DIQ(4,DUZ(2),99)
End DoDot:1
SET Y=-1
QUIT
+3 SET D0=ONCOD0
DO SDD^ONCOCOM
WRITE !?5,"Select primary to ",UTL,!
+4 SET D="C"
SET DIC="^ONCO(165.5,"
SET DIC(0)="EZ"
SET X=ONCOD0
DO IX^DIC
if (Y<0)!(Y=U)
QUIT
+5 QUIT
+6 ;
DIE1 ;Edit ONCOLOGY PRIMARY (165.5)
+1 SET (D0,ONCODP0,DA)=+Y
SET DR="[ONCO UTL CORRECT DATA]"
SET DIE="^ONCO(165.5,"
+2 SET ONCOL=0
+3 LOCK +^ONCO(165.5,ONCODP0):0
IF $TEST
DO ^DIE
LOCK -^ONCO(165.5,ONCODP0)
SET ONCOL=1
+4 IF 'ONCOL
WRITE !,"Record being edited by another user."
DO EX
GOTO PRIM
+5 SET Y=0
+6 SET ONCOD0P=D0
+7 SET ABSTAT=$PIECE($GET(^ONCO(165.5,ONCOD0P,7)),U,2)
+8 IF ABSTAT=3
SET EAFLAG="YES"
DO CHANGE^ONCGENED
+9 DO EX
+10 QUIT
+11 ;
PAT ;Select ONCOLOGY PATIENT (160)
+1 WRITE !
SET DIC="^ONCO(160,"
SET DIC(0)="AEZM"
DO ^DIC
KILL DIC
if Y<0
QUIT
+2 SET (ONCOD0,D0)=+Y
SET ONCONM=Y(0,0)
+3 NEW Y
KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR="2;3;8;10"
SET DA=ONCOD0
SET DIQ="ONC"
+4 DO EN^DIQ1
WRITE !
+5 WRITE !?2,"SSN..........: ",ONC(160,ONCOD0,2)
+6 WRITE ?35,"Race.........: ",ONC(160,ONCOD0,8)
+7 WRITE !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
+8 WRITE ?35,"Sex..........: ",ONC(160,ONCOD0,10)
+9 QUIT
+10 ;
DP ;Delete ONCOLOGY PRIMARY (165.5)
+1 ;W !?5,"Deleting ONCOLOGY PRIMARY: ",$$GET1^DIQ(165.5,ONCOP0,20)
+2 ;S DA=ONCOP0,DIK="^ONCO(165.5," D ^DIK S D0=ONCOD0 H 2 W !
+3 ;Q
+4 ;
DUPSQ ;[SQ Find Duplicate Acc/Seq numbers]
+1 KILL ONCPRLST
SET ONCTTLDP=0
WRITE !
+2 SET ONCACSQ=""
FOR
SET ONCACSQ=$ORDER(^ONCO(165.5,"D",ONCACSQ))
if ONCACSQ=""
QUIT
Begin DoDot:1
+3 SET ONCTTL=0
SET ONCDUPS=""
+4 FOR ZZIEN=0:0
SET ZZIEN=$ORDER(^ONCO(165.5,"D",ONCACSQ,ZZIEN))
if ZZIEN'>0
QUIT
Begin DoDot:2
+5 SET ONCTTL=ONCTTL+1
SET ONCDUPS=ONCDUPS_ZZIEN_"^"
+6 IF ONCTTL>1
Begin DoDot:3
+7 IF '$DATA(ONCPRLST(ONCACSQ))
SET ONCTTLDP=ONCTTLDP+1
+8 SET ONCPRLST(ONCACSQ)=ONCDUPS
End DoDot:3
End DoDot:2
End DoDot:1
+9 IF '$DATA(ONCPRLST)
WRITE !!?8,"No duplicate Accession/Sequence Numbers Found.",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+10 WRITE !
DO HDR^ONCOCOML
+11 SET ONCACSQ=""
FOR
SET ONCACSQ=$ORDER(ONCPRLST(ONCACSQ))
if ONCACSQ=""
QUIT
Begin DoDot:1
+12 FOR X=1:1:999
SET ONCXD1=$PIECE(ONCPRLST(ONCACSQ),U,X)
if ONCXD1=""
QUIT
DO DIS2^ONCOCOML
End DoDot:1
WRITE !
+13 WRITE !!?5,"A total of ",ONCTTLDP," Accession/Sequence numbers with duplicates found.",!?5,"You may use the EA 'Edit Site/AccSeq # Data' option to fix duplicates.",!
KILL DIR
SET DIR(0)="E"
DO ^DIR
QUIT
+14 KILL ONCPRLST,ONCTTLDP,ONCTTL,ONCACSQ,ONCDUPS,ZZIEN
QUIT
+15 ;
EX ;Kill variables
+1 KILL %ZIS,ABSTAT,D,D0,DA,DIC,DIE,DIK,DIQ,DIR,DR,EAFLAG,ONC,ONCDIV
+2 KILL ONCOD0P,ONCODA,ONCODP0,ONCOL,ONCONM,ONCOP0,ONCOSIT,ONCOUT,POP,UTL,X,Y
+3 QUIT
+4 ;
CLEANUP ;Cleanup
+1 KILL ONCOD0
