ECX335PT ;ALB/DKK/ESD - PATCH ECX*3.0*35 Post-Init ; 01/15/01
;;3.0;DSS EXTRACTS;**35**;Jan 15, 2001
;
; This cleanup routine will delete records in the CLINIC II (CLJ)
; Extract file (#727.818) if corresponding entries in the CLINIC I
; (CLI) Extract file (#727.816) do not exist as a result of an
; incomplete CLJ extract purge.
;
EN ;- Entry point for cleanup
;
N ZTRTN,ZTDESC,ZTIO
D BMES^XPDUTL(">>> Searching for incomplete purged CLJ extracts. If found, the incomplete")
D MES^XPDUTL(">>> purged CLJ extract records will be deleted from file #727.818.")
D MES^XPDUTL(">>> This purge will be queued.")
D MES^XPDUTL("")
;
;- Task job
S ZTRTN="DEL818^ECX335PT"
S ZTDESC="Deleting incomplete purged CLJ Extract records (#727.818)"
S ZTIO=""
D ^%ZTLOAD
D BMES^XPDUTL($S(+ZTSK:">>> Queued: Task# "_ZTSK,1:">>> Not Queued!"))
Q
;
;
DEL818 ;- Compare CLJ with CLI extract log number and delete CLJ record if no
; matching CLI record is found
;
N BAT,DA,DIK,ECJ
S BAT=0
F S BAT=$O(^ECX(727.818,"AC",BAT)) Q:'BAT D
. Q:$D(^ECX(727.816,"AC",BAT))
. S ECJ=0
. F S ECJ=$O(^ECX(727.818,"AC",BAT,ECJ)) Q:'ECJ D
.. S DIK="^ECX(727.818,",DA=ECJ D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX335PT 1219 printed Sep 23, 2025@19:25:57 Page 2
ECX335PT ;ALB/DKK/ESD - PATCH ECX*3.0*35 Post-Init ; 01/15/01
+1 ;;3.0;DSS EXTRACTS;**35**;Jan 15, 2001
+2 ;
+3 ; This cleanup routine will delete records in the CLINIC II (CLJ)
+4 ; Extract file (#727.818) if corresponding entries in the CLINIC I
+5 ; (CLI) Extract file (#727.816) do not exist as a result of an
+6 ; incomplete CLJ extract purge.
+7 ;
EN ;- Entry point for cleanup
+1 ;
+2 NEW ZTRTN,ZTDESC,ZTIO
+3 DO BMES^XPDUTL(">>> Searching for incomplete purged CLJ extracts. If found, the incomplete")
+4 DO MES^XPDUTL(">>> purged CLJ extract records will be deleted from file #727.818.")
+5 DO MES^XPDUTL(">>> This purge will be queued.")
+6 DO MES^XPDUTL("")
+7 ;
+8 ;- Task job
+9 SET ZTRTN="DEL818^ECX335PT"
+10 SET ZTDESC="Deleting incomplete purged CLJ Extract records (#727.818)"
+11 SET ZTIO=""
+12 DO ^%ZTLOAD
+13 DO BMES^XPDUTL($SELECT(+ZTSK:">>> Queued: Task# "_ZTSK,1:">>> Not Queued!"))
+14 QUIT
+15 ;
+16 ;
DEL818 ;- Compare CLJ with CLI extract log number and delete CLJ record if no
+1 ; matching CLI record is found
+2 ;
+3 NEW BAT,DA,DIK,ECJ
+4 SET BAT=0
+5 FOR
SET BAT=$ORDER(^ECX(727.818,"AC",BAT))
if 'BAT
QUIT
Begin DoDot:1
+6 if $DATA(^ECX(727.816,"AC",BAT))
QUIT
+7 SET ECJ=0
+8 FOR
SET ECJ=$ORDER(^ECX(727.818,"AC",BAT,ECJ))
if 'ECJ
QUIT
Begin DoDot:2
+9 SET DIK="^ECX(727.818,"
SET DA=ECJ
DO ^DIK
End DoDot:2
End DoDot:1
+10 QUIT
