- 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