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

DGMTDELS.m

Go to the documentation of this file.
  1. DGMTDELS ;ALB/GAH - Delete means test for deceased patient; August 14, 2006 14:35:54
  1. ;;5.3;Registration;**714,1015**;Aug 14, 2006;Build 21
  1. ;
  1. ; This routine deletes a patient's last means test if the patient
  1. ; is deceased and the last means test has a status of REQUIRED.
  1. ; It can be run in foreground at CHECK, OK2DELMT, or DELMT. It
  1. ; can be queued to run in background by calling line tag START.
  1. ;
  1. ; Must be run from line tag
  1. Q
  1. ;
  1. START(DFN) ;Start process
  1. N NAMSPC,TASK,U
  1. S U="^"
  1. D QUEUE($$QTIME)
  1. Q
  1. QUEUE(ZTDTH) ; Queue the process
  1. N NAMSPC,ZTRTN,ZTDESC,ZTIO,ZTSK
  1. S NAMSPC=$$NAMSPC
  1. S ZTRTN="CHECK^DGMTDELS("_DFN_")"
  1. S ZTDESC=NAMSPC_" - Remove REQUIRED MT for deceased patients"
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. D HOME^%ZIS
  1. Q
  1. QTIME() ; Get the run time for queuing
  1. N %,%H,%I,X
  1. D NOW^%DTC
  1. Q $P(%,".")_"."_$E($P(%,".",2),1,4)
  1. ;
  1. NAMSPC() ;
  1. Q $T(+0)
  1. CHECK(DFN) ; Check that the criteria to delete a means test is met
  1. N DGMTI
  1. F Q:'$$OK2DEL(DFN,.DGMTI) D DELMT(DGMTI) ; Delete means test with REQUIRED status
  1. Q
  1. OK2DEL(DFN,DGMTI) ;
  1. ; Returns 1 and the last mean test IEN if the patient has a date of death and
  1. ; the means test has a status of REQUIRED.
  1. N DGMT,STATUS,U
  1. S U="^"
  1. S DGMT=$$LST^DGMTU(DFN)
  1. Q:DGMT="" 0
  1. S STATUS=$P(DGMT,U,3)
  1. S DGMTI=$P(DGMT,U)
  1. ; Status must be REQUIRED
  1. Q:STATUS'="REQUIRED" 0
  1. ; There must be a date of death
  1. Q:'+$P($G(^DPT(DFN,.35)),U) 0
  1. Q 1
  1. DELMT(DGMTI) ;
  1. ; Delete the means test
  1. N DFN,DGMT0,DGMTD,DGMTYPT,DQ,U
  1. S U="^"
  1. S DGMT0=$G(^DGMT(408.31,DGMTI,0))
  1. Q:DGMT0=""
  1. S DFN=$P(DGMT0,U,2)
  1. S DGMTD=$P(DGMT0,U)
  1. S DGMTYPT=$P(DGMT0,U,19)
  1. D VAR^DGMTDEL1
  1. D DEL^DGMTDEL1
  1. Q