Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOUTC

ONCOUTC.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. INQ ;[PI Patient/Primary Inquiry]
  1.  ;OUT OF ORDER MESSAGE: Marked for deletion
  1.  D PAT G EX:Y<0
  1.  I $$PFTD^ONCFUNC(ONCOD0)="N" D  G INQ
  1.  .W !!?5,ONCONM," has no primaries for division: ",$$GET1^DIQ(4,DUZ(2),99)
  1.  D SDD^ONCOCOM G INQ
  1.  ;
  1. DUMP ;[RD Print Oncology Patient Record]
  1.  ;OUT OF ORDER MESSAGE: Marked for deletion
  1.  ;W !,?5,"This option will display the entire Oncology Record from"
  1.  ;W !?5,"both the ONCOLOGY PATIENT and the ONCOLOGY PRIMARY files",!!
  1. 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
  1.  ;I '$D(IO("Q")) D DIQ W !!! G SEL
  1.  ;S ZTRTN="DIQ^ONCOUTC",ZTSAVE("ONCODA")="",ZTSAVE("DUZ(2)")=""
  1.  ;S ZTDESC="ONCOLOGY PATIENT RECORD"
  1.  ;D ^%ZTLOAD
  1.  ;K ZTDESC,ZTRTN,ZTSAVE
  1.  ;D EX
  1.  ;Q
  1.  ;
  1. EN2 ;[DP Delete Oncology Patient]
  1.  W !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
  1.  W ! K DIR S DIR(0)="E" D ^DIR Q
  1.  ;OUT OF ORDER MESSAGE: Marked for deletion
  1.  ;D PAT G EX:Y<0
  1.  ;I $D(^ONCO(165.5,"C",ONCOD0)) D SDD^ONCOCOM
  1.  ;W !?5,"Deleting a patient will also delete any primaries associated"
  1.  ;W !?5,"with your division."
  1.  ;S DIR("A")="     Are you sure you want to delete this ONCOLOGY PATIENT"
  1.  ;S DIR("B")="NO",DIR(0)="Y" W ! D ^DIR G EX:Y=U!(Y=""),EN2:'Y
  1.  ;W !
  1.  ;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
  1.  ;I $D(^ONCO(165.5,"C",ONCOD0)) D  G EN2
  1.  ;.S ONCOP0=$O(^ONCO(165.5,"C",ONCOD0,0))
  1.  ;.S ONCDIV=$P($G(^ONCO(165.5,ONCOP0,"DIV")),U,1)
  1.  ;.W !?5,"Unable to delete ONCOLOGY PATIENT."
  1.  ;.W !?5,"This patient has primaries which belong to division: ",ONCDIV,!
  1.  ;S DA=ONCOD0,DIK="^ONCO(160,"
  1.  ;W !!?5,"Deleting ONCOLOGY PATIENT..." D ^DIK G EN2
  1.  ;
  1. EN3 ;[DS Delete Primary Site/GP Record]
  1.  W !!,"*** THIS OPTION IS OUT OF ORDER: Marked for deletion"
  1.  W ! K DIR S DIR(0)="E" D ^DIR Q
  1.  ;OUT OF ORDER MESSAGE: Marked for deletion
  1.  ;D PAT G EX:Y<0
  1.  ;S UTL="DELETE" D PRIM G EN3:Y<0
  1.  ;S ONCOSIT=$P(Y,U,2),ONCOP0=+Y
  1.  ;W !!?5,ONCONM,?35,$P(^ONCO(164.2,ONCOSIT,0),U),!!
  1.  ;S DIR("A")=" Are you sure you want to delete this primary"
  1.  ;S DIR("B")="NO",DIR(0)="Y" D ^DIR G EX:(Y="")!(Y=U),EN3:Y=0
  1.  ;D DP G EN3
  1.  ;
  1. EN1 ;[EA Edit Site/AccSeq# Data]
  1.  D PAT G EX:Y<0
  1. SP S UTL="EDIT" D PRIM G:Y'>0 EN1 D DIE1
  1.  S DIR("A")="Data OK",DIR("B")="Y",DIR(0)="Y"
  1.  D ^DIR Q:Y=U!(Y="")  G:Y=0 SP G EN1
  1.  ;
  1. PRIM ;Select ONCOLOGY PRIMARY (165.5)
  1.  I $$PFTD^ONCFUNC(ONCOD0)="N" D  S Y=-1 Q
  1.  .W !!?5,ONCONM," has no primaries for division: ",$$GET1^DIQ(4,DUZ(2),99)
  1.  S D0=ONCOD0 D SDD^ONCOCOM W !?5,"Select primary to ",UTL,!
  1.  S D="C",DIC="^ONCO(165.5,",DIC(0)="EZ",X=ONCOD0 D IX^DIC Q:(Y<0)!(Y=U)
  1.  Q
  1.  ;
  1. DIE1 ;Edit ONCOLOGY PRIMARY (165.5)
  1.  S (D0,ONCODP0,DA)=+Y,DR="[ONCO UTL CORRECT DATA]",DIE="^ONCO(165.5,"
  1.  S ONCOL=0
  1.  L +^ONCO(165.5,ONCODP0):0 I $T D ^DIE L -^ONCO(165.5,ONCODP0) S ONCOL=1
  1.  I 'ONCOL W !,"Record being edited by another user." D EX G PRIM
  1.  S Y=0
  1.  S ONCOD0P=D0
  1.  S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
  1.  I ABSTAT=3 S EAFLAG="YES" D CHANGE^ONCGENED
  1.  D EX
  1.  Q
  1.  ;
  1. PAT ;Select ONCOLOGY PATIENT (160)
  1.  W ! S DIC="^ONCO(160,",DIC(0)="AEZM" D ^DIC K DIC Q:Y<0
  1.  S (ONCOD0,D0)=+Y,ONCONM=Y(0,0)
  1.  N Y K DIQ,ONC S DIC="^ONCO(160,",DR="2;3;8;10",DA=ONCOD0,DIQ="ONC"
  1.  D EN^DIQ1 W !
  1.  W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
  1.  W ?35,"Race.........: ",ONC(160,ONCOD0,8)
  1.  W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
  1.  W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
  1.  Q
  1.  ;
  1. DP ;Delete ONCOLOGY PRIMARY (165.5)
  1.  ;W !?5,"Deleting ONCOLOGY PRIMARY: ",$$GET1^DIQ(165.5,ONCOP0,20)
  1.  ;S DA=ONCOP0,DIK="^ONCO(165.5," D ^DIK S D0=ONCOD0 H 2 W !
  1.  ;Q
  1.  ;
  1. DUPSQ ;[SQ Find Duplicate Acc/Seq numbers]
  1.  K ONCPRLST S ONCTTLDP=0 W !
  1.  S ONCACSQ="" F  S ONCACSQ=$O(^ONCO(165.5,"D",ONCACSQ)) Q:ONCACSQ=""  D
  1.  .S ONCTTL=0,ONCDUPS=""
  1.  .F ZZIEN=0:0 S ZZIEN=$O(^ONCO(165.5,"D",ONCACSQ,ZZIEN)) Q:ZZIEN'>0  D
  1.  ..S ONCTTL=ONCTTL+1,ONCDUPS=ONCDUPS_ZZIEN_"^"
  1.  ..I ONCTTL>1 D
  1.  ...I '$D(ONCPRLST(ONCACSQ)) S ONCTTLDP=ONCTTLDP+1
  1.  ...S ONCPRLST(ONCACSQ)=ONCDUPS
  1.  I '$D(ONCPRLST) W !!?8,"No duplicate Accession/Sequence Numbers Found.",! K DIR S DIR(0)="E" D ^DIR Q
  1.  W ! D HDR^ONCOCOML
  1.  S ONCACSQ="" F  S ONCACSQ=$O(ONCPRLST(ONCACSQ)) Q:ONCACSQ=""  D  W !
  1.  .F X=1:1:999 S ONCXD1=$P(ONCPRLST(ONCACSQ),U,X) Q:ONCXD1=""  D DIS2^ONCOCOML
  1.  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
  1.  K ONCPRLST,ONCTTLDP,ONCTTL,ONCACSQ,ONCDUPS,ZZIEN Q
  1.  ;
  1. EX ;Kill variables
  1.  K %ZIS,ABSTAT,D,D0,DA,DIC,DIE,DIK,DIQ,DIR,DR,EAFLAG,ONC,ONCDIV
  1.  K ONCOD0P,ONCODA,ONCODP0,ONCOL,ONCONM,ONCOP0,ONCOSIT,ONCOUT,POP,UTL,X,Y
  1.  Q
  1.  ;
  1. CLEANUP ;Cleanup
  1.  K ONCOD0