63 lines
1.6 KiB
Mathematica
63 lines
1.6 KiB
Mathematica
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
|