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.
DGMTDELS ;ALB/GAH - Delete means test for deceased patient; August 14, 2006 14:35:54
 ;;5.3;Registration;**714,1015**;Aug 14, 2006;Build 21
 ;
 ; 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