ECX335PT.m

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 ---ECX335PT   1219     printed  Feb 18, 2025@23:16:19                                                                                                                                                                                                    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