ONCOAS ;Hines OIFO/GWB - [SE Add/Edit/Delete 'Suspense' Case] ;05/30/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
PAT ;[SE Add/Edit/Delete 'Suspense' Case]
W ! S DIC="^ONCO(160,",DIC(0)="AEZML",DLAYGO=160 D ^DIC G:Y<0 EX
S (D0,ONCOD0)=+Y
N Y K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !?1,"Patient Name.................: ",ONC(160,ONCOD0,.01)
W !?1,"Date of Last Contact or Death: ",ONC(160,ONCOD0,16)
W !?1,"Vital Status.................: ",ONC(160,ONCOD0,15)
W !?1,"Follow-Up Status.............: ",ONC(160,ONCOD0,15.2)
D SDD^ONCOCOM
I $D(^ONCO(160,ONCOD0,"SUS","C",DUZ(2))) D D DEL G PAT
.S SUSIEN=$O(^ONCO(160,ONCOD0,"SUS","C",DUZ(2),0))
.S DIE="^ONCO(160,"_ONCOD0_",""SUS"",",DA(1)=ONCOD0,DA=SUSIEN
.S DR=".01;3" D ^DIE
S DA(1)=ONCOD0,DIC="^ONCO(160,"_ONCOD0_",""SUS"",",DIC(0)="QEAL"
S DIC("A")="SUSPENSE DATE: "
S DIC("S")="I $P(^ONCO(160,DA(1),""SUS"",Y,0),U,4)=DUZ(2)"
D ^DIC I Y=-1 K DIC,DA D DEL G PAT
S DIE=DIC K DIC
S DA=+Y,DR="1///^S X=DT;2///^S X=""SE"";3////^S X=DUZ(2)"
S ONCOL=0 L +^ONCO(160,DA):0 I $T D ^DIE L -^ONCO(160,DA) S ONCOL=1
I 'ONCOL W !,"This patient is being edited by another user." G PAT
K ONCOL,DIE,DR,DA,Y
D DEL G PAT
;
EX ;Exit
K X,Y,D0,DA,DIC,DIE,DIK,DIQ,DLAYGO,DR
K ONC,ONCOD0,ONCOL,SUSIEN
Q
;
DEL ;Delete patients who are not on suspense and have no primaries
I $O(^ONCO(160,ONCOD0,"SUS",0))="",'$D(^ONCO(165.5,"C",ONCOD0)) D
.N DIK,DA S DIK="^ONCO(160,",DA=ONCOD0 D ^DIK
.W !!?3,*7,"This patient is not on suspense and has no primaries."
.W !?3,"This patient's record has been deleted."
Q
;
PURGE ;PSR Purge Suspense Records [ONCO UTIL-PURGE SUSPENSE]
W !
W !," This option will purge suspense records. The user may purge ALL suspense"
W !," records or the suspense records for a selected SUSPENSE DATE range."
W !
W !," NOTE: Only suspense records which belong to your division will be purged."
W !
W !," If, after the suspense record purge, the patient has no suspense records"
W !," and no primaries (for any division), the tumor registry patient record"
W !," will also be purged."
W !
K DIR
S DIR("A")=" Select purge option"
S DIR(0)="SO^1:ALL suspense records for your division;2:Range of suspense records by SUSPENSE DATE"
D ^DIR K DIR Q:$D(DIRUT)
I Y=1 S ANS="YES" G PSR
I Y=2 S ANS="NO"
K DIR
W !
S DIR(0)="D"
S DIR("A")=" Start Suspense Date"
S DIR("?")=" "
S DIR("?",1)=" Enter the SUSPENSE DATE of the first suspense record you would like to purge."
D ^DIR I $D(DIRUT) Q
S SDT=Y
S DIR("A")=" End Suspense Date"
S DIR("?",1)=" Enter the SUSPENSE DATE of the last suspense record you would like to purge."
D ^DIR I $D(DIRUT) Q
S EDT=Y
PSR W !
K DIR,ONC
S DIR("A")=" Are you sure you want to purge suspense records"
S DIR("B")="No"
S DIR(0)="Y" D ^DIR
I Y=0 Q
I ANS="YES" S X0=0,EDT=9999999
I ANS="NO" S X0=SDT-1
S CNT=0
F S X0=$O(^ONCO(160,"ADX",X0)) Q:('X0)!(X0>EDT) S X1=0 F S X1=$O(^ONCO(160,"ADX",X0,X1)) Q:'X1 S X2=0 F S X2=$O(^ONCO(160,"ADX",X0,X1,X2)) Q:'X2 I $$SUSDIV^ONCFUNC(X1,X2)=DUZ(2) D
.S DA(1)=X1,DA=X2,DIK="^ONCO(160,"_DA(1)_",""SUS""," D ^DIK
.S CNT=CNT+1
.S ONC(X1)=""
.W "."
S PATCNT=0,SUB=0 F S SUB=$O(ONC(SUB)) Q:'SUB D
.I $O(^ONCO(160,SUB,"SUS",0))="",'$D(^ONCO(165.5,"C",SUB)) D
..N DIK,DA S DIK="^ONCO(160,",DA=SUB D ^DIK S PATCNT=PATCNT+1
W !!,?3,CNT," Suspense ",$S(CNT=1:"record",1:"records")," purged"
W !,?3,PATCNT," Tumor Registry patient ",$S(CNT=1:"record",1:"records")," purged"
K ANS,CNT,EDT,ONC,PATCNT,SDT,X0,X1,X2,Y,DA,DIK,DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAS 3671 printed Apr 09, 2024@21:28:10 Page 2
ONCOAS ;Hines OIFO/GWB - [SE Add/Edit/Delete 'Suspense' Case] ;05/30/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
PAT ;[SE Add/Edit/Delete 'Suspense' Case]
+1 WRITE !
SET DIC="^ONCO(160,"
SET DIC(0)="AEZML"
SET DLAYGO=160
DO ^DIC
if Y<0
GOTO EX
+2 SET (D0,ONCOD0)=+Y
+3 NEW Y
KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR=".01;16;15;15.2"
SET DA=ONCOD0
SET DIQ="ONC"
+4 DO EN^DIQ1
WRITE !
+5 WRITE !?1,"Patient Name.................: ",ONC(160,ONCOD0,.01)
+6 WRITE !?1,"Date of Last Contact or Death: ",ONC(160,ONCOD0,16)
+7 WRITE !?1,"Vital Status.................: ",ONC(160,ONCOD0,15)
+8 WRITE !?1,"Follow-Up Status.............: ",ONC(160,ONCOD0,15.2)
+9 DO SDD^ONCOCOM
+10 IF $DATA(^ONCO(160,ONCOD0,"SUS","C",DUZ(2)))
Begin DoDot:1
+11 SET SUSIEN=$ORDER(^ONCO(160,ONCOD0,"SUS","C",DUZ(2),0))
+12 SET DIE="^ONCO(160,"_ONCOD0_",""SUS"","
SET DA(1)=ONCOD0
SET DA=SUSIEN
+13 SET DR=".01;3"
DO ^DIE
End DoDot:1
DO DEL
GOTO PAT
+14 SET DA(1)=ONCOD0
SET DIC="^ONCO(160,"_ONCOD0_",""SUS"","
SET DIC(0)="QEAL"
+15 SET DIC("A")="SUSPENSE DATE: "
+16 SET DIC("S")="I $P(^ONCO(160,DA(1),""SUS"",Y,0),U,4)=DUZ(2)"
+17 DO ^DIC
IF Y=-1
KILL DIC,DA
DO DEL
GOTO PAT
+18 SET DIE=DIC
KILL DIC
+19 SET DA=+Y
SET DR="1///^S X=DT;2///^S X=""SE"";3////^S X=DUZ(2)"
+20 SET ONCOL=0
LOCK +^ONCO(160,DA):0
IF $TEST
DO ^DIE
LOCK -^ONCO(160,DA)
SET ONCOL=1
+21 IF 'ONCOL
WRITE !,"This patient is being edited by another user."
GOTO PAT
+22 KILL ONCOL,DIE,DR,DA,Y
+23 DO DEL
GOTO PAT
+24 ;
EX ;Exit
+1 KILL X,Y,D0,DA,DIC,DIE,DIK,DIQ,DLAYGO,DR
+2 KILL ONC,ONCOD0,ONCOL,SUSIEN
+3 QUIT
+4 ;
DEL ;Delete patients who are not on suspense and have no primaries
+1 IF $ORDER(^ONCO(160,ONCOD0,"SUS",0))=""
IF '$DATA(^ONCO(165.5,"C",ONCOD0))
Begin DoDot:1
+2 NEW DIK,DA
SET DIK="^ONCO(160,"
SET DA=ONCOD0
DO ^DIK
+3 WRITE !!?3,*7,"This patient is not on suspense and has no primaries."
+4 WRITE !?3,"This patient's record has been deleted."
End DoDot:1
+5 QUIT
+6 ;
PURGE ;PSR Purge Suspense Records [ONCO UTIL-PURGE SUSPENSE]
+1 WRITE !
+2 WRITE !," This option will purge suspense records. The user may purge ALL suspense"
+3 WRITE !," records or the suspense records for a selected SUSPENSE DATE range."
+4 WRITE !
+5 WRITE !," NOTE: Only suspense records which belong to your division will be purged."
+6 WRITE !
+7 WRITE !," If, after the suspense record purge, the patient has no suspense records"
+8 WRITE !," and no primaries (for any division), the tumor registry patient record"
+9 WRITE !," will also be purged."
+10 WRITE !
+11 KILL DIR
+12 SET DIR("A")=" Select purge option"
+13 SET DIR(0)="SO^1:ALL suspense records for your division;2:Range of suspense records by SUSPENSE DATE"
+14 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+15 IF Y=1
SET ANS="YES"
GOTO PSR
+16 IF Y=2
SET ANS="NO"
+17 KILL DIR
+18 WRITE !
+19 SET DIR(0)="D"
+20 SET DIR("A")=" Start Suspense Date"
+21 SET DIR("?")=" "
+22 SET DIR("?",1)=" Enter the SUSPENSE DATE of the first suspense record you would like to purge."
+23 DO ^DIR
IF $DATA(DIRUT)
QUIT
+24 SET SDT=Y
+25 SET DIR("A")=" End Suspense Date"
+26 SET DIR("?",1)=" Enter the SUSPENSE DATE of the last suspense record you would like to purge."
+27 DO ^DIR
IF $DATA(DIRUT)
QUIT
+28 SET EDT=Y
PSR WRITE !
+1 KILL DIR,ONC
+2 SET DIR("A")=" Are you sure you want to purge suspense records"
+3 SET DIR("B")="No"
+4 SET DIR(0)="Y"
DO ^DIR
+5 IF Y=0
QUIT
+6 IF ANS="YES"
SET X0=0
SET EDT=9999999
+7 IF ANS="NO"
SET X0=SDT-1
+8 SET CNT=0
+9 FOR
SET X0=$ORDER(^ONCO(160,"ADX",X0))
if ('X0)!(X0>EDT)
QUIT
SET X1=0
FOR
SET X1=$ORDER(^ONCO(160,"ADX",X0,X1))
if 'X1
QUIT
SET X2=0
FOR
SET X2=$ORDER(^ONCO(160,"ADX",X0,X1,X2))
if 'X2
QUIT
IF $$SUSDIV^ONCFUNC(X1,X2)=DUZ(2)
Begin DoDot:1
+10 SET DA(1)=X1
SET DA=X2
SET DIK="^ONCO(160,"_DA(1)_",""SUS"","
DO ^DIK
+11 SET CNT=CNT+1
+12 SET ONC(X1)=""
+13 WRITE "."
End DoDot:1
+14 SET PATCNT=0
SET SUB=0
FOR
SET SUB=$ORDER(ONC(SUB))
if 'SUB
QUIT
Begin DoDot:1
+15 IF $ORDER(^ONCO(160,SUB,"SUS",0))=""
IF '$DATA(^ONCO(165.5,"C",SUB))
Begin DoDot:2
+16 NEW DIK,DA
SET DIK="^ONCO(160,"
SET DA=SUB
DO ^DIK
SET PATCNT=PATCNT+1
End DoDot:2
End DoDot:1
+17 WRITE !!,?3,CNT," Suspense ",$SELECT(CNT=1:"record",1:"records")," purged"
+18 WRITE !,?3,PATCNT," Tumor Registry patient ",$SELECT(CNT=1:"record",1:"records")," purged"
+19 KILL ANS,CNT,EDT,ONC,PATCNT,SDT,X0,X1,X2,Y,DA,DIK,DIR
+20 QUIT
