- 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 Feb 18, 2025@23:50:57 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