| 1 | DGMTDELS ;ALB/GAH - Delete means test for deceased patient; August 14, 2006 14:35:54
|
|---|
| 2 | ;;5.3;Registration;**714**;Aug 14, 2006;Build 5
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine deletes a patient's last means test if the patient
|
|---|
| 5 | ; is deceased and the last means test has a status of REQUIRED.
|
|---|
| 6 | ; It can be run in foreground at CHECK, OK2DELMT, or DELMT. It
|
|---|
| 7 | ; can be queued to run in background by calling line tag START.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Must be run from line tag
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | START(DFN) ;Start process
|
|---|
| 13 | N NAMSPC,TASK,U
|
|---|
| 14 | S U="^"
|
|---|
| 15 | D QUEUE($$QTIME)
|
|---|
| 16 | Q
|
|---|
| 17 | QUEUE(ZTDTH) ; Queue the process
|
|---|
| 18 | N NAMSPC,ZTRTN,ZTDESC,ZTIO,ZTSK
|
|---|
| 19 | S NAMSPC=$$NAMSPC
|
|---|
| 20 | S ZTRTN="CHECK^DGMTDELS("_DFN_")"
|
|---|
| 21 | S ZTDESC=NAMSPC_" - Remove REQUIRED MT for deceased patients"
|
|---|
| 22 | S ZTIO=""
|
|---|
| 23 | D ^%ZTLOAD
|
|---|
| 24 | D HOME^%ZIS
|
|---|
| 25 | Q
|
|---|
| 26 | QTIME() ; Get the run time for queuing
|
|---|
| 27 | N %,%H,%I,X
|
|---|
| 28 | D NOW^%DTC
|
|---|
| 29 | Q $P(%,".")_"."_$E($P(%,".",2),1,4)
|
|---|
| 30 | ;
|
|---|
| 31 | NAMSPC() ;
|
|---|
| 32 | Q $T(+0)
|
|---|
| 33 | CHECK(DFN) ; Check that the criteria to delete a means test is met
|
|---|
| 34 | N DGMTI
|
|---|
| 35 | F Q:'$$OK2DEL(DFN,.DGMTI) D DELMT(DGMTI) ; Delete means test with REQUIRED status
|
|---|
| 36 | Q
|
|---|
| 37 | OK2DEL(DFN,DGMTI) ;
|
|---|
| 38 | ; Returns 1 and the last mean test IEN if the patient has a date of death and
|
|---|
| 39 | ; the means test has a status of REQUIRED.
|
|---|
| 40 | N DGMT,STATUS,U
|
|---|
| 41 | S U="^"
|
|---|
| 42 | S DGMT=$$LST^DGMTU(DFN)
|
|---|
| 43 | Q:DGMT="" 0
|
|---|
| 44 | S STATUS=$P(DGMT,U,3)
|
|---|
| 45 | S DGMTI=$P(DGMT,U)
|
|---|
| 46 | ; Status must be REQUIRED
|
|---|
| 47 | Q:STATUS'="REQUIRED" 0
|
|---|
| 48 | ; There must be a date of death
|
|---|
| 49 | Q:'+$P($G(^DPT(DFN,.35)),U) 0
|
|---|
| 50 | Q 1
|
|---|
| 51 | DELMT(DGMTI) ;
|
|---|
| 52 | ; Delete the means test
|
|---|
| 53 | N DFN,DGMT0,DGMTD,DGMTYPT,DQ,U
|
|---|
| 54 | S U="^"
|
|---|
| 55 | S DGMT0=$G(^DGMT(408.31,DGMTI,0))
|
|---|
| 56 | Q:DGMT0=""
|
|---|
| 57 | S DFN=$P(DGMT0,U,2)
|
|---|
| 58 | S DGMTD=$P(DGMT0,U)
|
|---|
| 59 | S DGMTYPT=$P(DGMT0,U,19)
|
|---|
| 60 | D VAR^DGMTDEL1
|
|---|
| 61 | D DEL^DGMTDEL1
|
|---|
| 62 | Q
|
|---|
