DGMTDELS.m

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

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

 +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