DGMTDELS ;ALB/GAH - Delete means test for deceased patient; August 14, 2006 14:35:54
;;5.3;Registration;**714**;Aug 14, 2006;Build 5
;
; This routine deletes a patient's last means test if the patient
; is deceased and the last means test has a status of REQUIRED.
; It can be run in foreground at CHECK, OK2DELMT, or DELMT. It
; can be queued to run in background by calling line tag START.
;
; Must be run from line tag
Q
;
START(DFN) ;Start process
N NAMSPC,TASK,U
S U="^"
D QUEUE($$QTIME)
Q
QUEUE(ZTDTH) ; Queue the process
N NAMSPC,ZTRTN,ZTDESC,ZTIO,ZTSK
S NAMSPC=$$NAMSPC
S ZTRTN="CHECK^DGMTDELS("_DFN_")"
S ZTDESC=NAMSPC_" - Remove REQUIRED MT for deceased patients"
S ZTIO=""
D ^%ZTLOAD
D HOME^%ZIS
Q
QTIME() ; Get the run time for queuing
N %,%H,%I,X
D NOW^%DTC
Q $P(%,".")_"."_$E($P(%,".",2),1,4)
;
NAMSPC() ;
Q $T(+0)
CHECK(DFN) ; Check that the criteria to delete a means test is met
N DGMTI
F Q:'$$OK2DEL(DFN,.DGMTI) D DELMT(DGMTI) ; Delete means test with REQUIRED status
Q
OK2DEL(DFN,DGMTI) ;
; Returns 1 and the last mean test IEN if the patient has a date of death and
; the means test has a status of REQUIRED.
N DGMT,STATUS,U
S U="^"
S DGMT=$$LST^DGMTU(DFN)
Q:DGMT="" 0
S STATUS=$P(DGMT,U,3)
S DGMTI=$P(DGMT,U)
; Status must be REQUIRED
Q:STATUS'="REQUIRED" 0
; There must be a date of death
Q:'+$P($G(^DPT(DFN,.35)),U) 0
Q 1
DELMT(DGMTI) ;
; Delete the means test
N DFN,DGMT0,DGMTD,DGMTYPT,DQ,U
S U="^"
S DGMT0=$G(^DGMT(408.31,DGMTI,0))
Q:DGMT0=""
S DFN=$P(DGMT0,U,2)
S DGMTD=$P(DGMT0,U)
S DGMTYPT=$P(DGMT0,U,19)
D VAR^DGMTDEL1
D DEL^DGMTDEL1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTDELS 1689 printed Sep 23, 2025@20:20:43 Page 2
DGMTDELS ;ALB/GAH - Delete means test for deceased patient; August 14, 2006 14:35:54
+1 ;;5.3;Registration;**714**;Aug 14, 2006;Build 5
+2 ;
+3 ; This routine deletes a patient's last means test if the patient
+4 ; is deceased and the last means test has a status of REQUIRED.
+5 ; It can be run in foreground at CHECK, OK2DELMT, or DELMT. It
+6 ; can be queued to run in background by calling line tag START.
+7 ;
+8 ; Must be run from line tag
+9 QUIT
+10 ;
START(DFN) ;Start process
+1 NEW NAMSPC,TASK,U
+2 SET U="^"
+3 DO QUEUE($$QTIME)
+4 QUIT
QUEUE(ZTDTH) ; Queue the process
+1 NEW NAMSPC,ZTRTN,ZTDESC,ZTIO,ZTSK
+2 SET NAMSPC=$$NAMSPC
+3 SET ZTRTN="CHECK^DGMTDELS("_DFN_")"
+4 SET ZTDESC=NAMSPC_" - Remove REQUIRED MT for deceased patients"
+5 SET ZTIO=""
+6 DO ^%ZTLOAD
+7 DO HOME^%ZIS
+8 QUIT
QTIME() ; Get the run time for queuing
+1 NEW %,%H,%I,X
+2 DO NOW^%DTC
+3 QUIT $PIECE(%,".")_"."_$EXTRACT($PIECE(%,".",2),1,4)
+4 ;
NAMSPC() ;
+1 QUIT $TEXT(+0)
CHECK(DFN) ; Check that the criteria to delete a means test is met
+1 NEW DGMTI
+2 ; Delete means test with REQUIRED status
FOR
if '$$OK2DEL(DFN,.DGMTI)
QUIT
DO DELMT(DGMTI)
+3 QUIT
OK2DEL(DFN,DGMTI) ;
+1 ; Returns 1 and the last mean test IEN if the patient has a date of death and
+2 ; the means test has a status of REQUIRED.
+3 NEW DGMT,STATUS,U
+4 SET U="^"
+5 SET DGMT=$$LST^DGMTU(DFN)
+6 if DGMT=""
QUIT 0
+7 SET STATUS=$PIECE(DGMT,U,3)
+8 SET DGMTI=$PIECE(DGMT,U)
+9 ; Status must be REQUIRED
+10 if STATUS'="REQUIRED"
QUIT 0
+11 ; There must be a date of death
+12 if '+$PIECE($GET(^DPT(DFN,.35)),U)
QUIT 0
+13 QUIT 1
DELMT(DGMTI) ;
+1 ; Delete the means test
+2 NEW DFN,DGMT0,DGMTD,DGMTYPT,DQ,U
+3 SET U="^"
+4 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
+5 if DGMT0=""
QUIT
+6 SET DFN=$PIECE(DGMT0,U,2)
+7 SET DGMTD=$PIECE(DGMT0,U)
+8 SET DGMTYPT=$PIECE(DGMT0,U,19)
+9 DO VAR^DGMTDEL1
+10 DO DEL^DGMTDEL1
+11 QUIT
