Routine: DVBAYAPE

DVBAYAPE ;ALB/MLI - Clean-up stray APE cross-references ; 2/15/96@1pm

 ;;2.7;AMIE;**4**;Apr 10, 1995

 ; this routine will queue a process to run which will cleanup

 ; any errant APE cross-references

EN ; begin processing

 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 S ZTRTN="DQ^DVBAYAPE",ZTDESC="DVBA*2.7*4 - APE x-ref cleanup process"

 S ZTDTH=XPDQUES("POS001"),ZTIO="",ZTSAVE("DVBAKILL")=""

 D ^%ZTLOAD

 I $D(ZTSK) D BMES^XPDUTL(" APE x-ref cleanup queued...task="_ZTSK)

DQ ; dequeue task (or call in direct mode)

 D CLEAN

 D MAIL

CLEAN ; cleanup data

 S DVBACT=3 ; counter for bad x-refs...start after first 3 lines

 K ^TMP("DVBA*2.7*4",$J)

 D LINE(1,"Start Time of process:  "_$$NOW^XLFDT())

 D LINE(2," ")

 D LINE(3,"Results of search in DA^DFN^Request Date^Exam Type format")

 S DIK="^DVB(396.4,"

 F DFN=0:0 S DFN=$O(^DVB(396.4,"APE",DFN)) Q:'DFN  D

 . S DVBAET=0 ; loop variable for exam type

 . F  S DVBAET=$O(^DVB(396.4,"APE",DFN,DVBAET)) Q:DVBAET=""  D

 . . S DVBARD=0 ; loop variable for request date

 . . F  S DVBARD=$O(^DVB(396.4,"APE",DFN,DVBAET,DVBARD)) Q:'DVBARD  D

 . . . S DA=$O(^DVB(396.4,"APE",DFN,DVBAET,DVBARD,0))

 . . . S DVBA0ND=$G(^DVB(396.4,+DA,0)),DVBAD=0

 . . . I $G(^DVB(396.6,+$O(^DVB(396.6,"B",$E(DVBAET,1,30),0)),0))']"" S DVBAD=1

 . . . I DVBA0ND']""!DVBAD D  ; exam doesn't exist or event type name is bad

 . . . . S DVBACT=DVBACT+1

 . . . . D LINE(DVBACT,DA_"^"_DFN_"^"_DVBARD_"^"_DVBAET)

 . . . . I $G(DVBAKILL)="NO" Q  ; don't cleanup

 . . . . K ^DVB(396.4,"APE",DFN,DVBAET,DVBARD,DA)

 . . . . I DVBA0ND]"" D IX1^DIK ; reindex entry (sets only)

 I DVBACT=3 S DVBACT=DVBACT+1 D LINE(DVBACT,"No bad APE x-refs found!")

 D LINE(DVBACT+1,"End Time:  "_$$NOW^XLFDT())

 I $G(DVBAKILL)="NO" D LINE(DVBACT+2,"NOTHING WAS KILLED!!  D EN^DVBAYAPE TO HAVE KILLS EXECUTED")

 K DA,DFN,DIK,DVBA0ND,DVBACT,DVBAD,DVBAET,DVBARD

LINE(NUMBER,TEXT) ; set data into TMP global for e-mail message

 S ^TMP("DVBA*2.7*4",$J,NUMBER)=TEXT

MAIL ; mail message of results

 N DIFROM

 S XMSUB="DVBA*2.7*4 "_$S($G(DVBAKILL)'="NO":"Cleanup",1:"Diagnostic")_" has run"

 S XMTEXT="^TMP(""DVBA*2.7*4"",$J,"

 S XMY(DUZ)="",XMDUZ=.5

 D ^XMD

 K XMDUZ,XMSUB,XMTEXT,XMY

NOKILL ; don't kill anything

 S DVBAKILL="NO"

 D EN

 K DVBAKILL

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAYAPE   2348     printed  Mar 13, 2025@20:47:42                                                                                                                                                                                                    Page 2

DVBAYAPE  ;ALB/MLI - Clean-up stray APE cross-references ; 2/15/96@1pm

 +1       ;;2.7;AMIE;**4**;Apr 10, 1995

 +2       ;

 +3       ; this routine will queue a process to run which will cleanup

 +4       ; any errant APE cross-references

 +5       ;

EN        ; begin processing

 +1        NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK

 +2        SET ZTRTN="DQ^DVBAYAPE"

           SET ZTDESC="DVBA*2.7*4 - APE x-ref cleanup process"

 +3        SET ZTDTH=XPDQUES("POS001")

           SET ZTIO=""

           SET ZTSAVE("DVBAKILL")=""

 +4        DO ^%ZTLOAD

 +5        IF $DATA(ZTSK)

               DO BMES^XPDUTL(" APE x-ref cleanup queued...task="_ZTSK)

 +6        QUIT

 +7       ;

 +8       ;

DQ        ; dequeue task (or call in direct mode)

 +1        DO CLEAN

 +2        DO MAIL

 +3        QUIT

 +4       ;

 +5       ;

CLEAN     ; cleanup data

 +1       ; counter for bad x-refs...start after first 3 lines

           SET DVBACT=3

 +2        KILL ^TMP("DVBA*2.7*4",$JOB)

 +3        DO LINE(1,"Start Time of process:  "_$$NOW^XLFDT())

 +4        DO LINE(2," ")

 +5        DO LINE(3,"Results of search in DA^DFN^Request Date^Exam Type format")

 +6        SET DIK="^DVB(396.4,"

 +7        FOR DFN=0:0

               SET DFN=$ORDER(^DVB(396.4,"APE",DFN))

               if 'DFN

                   QUIT

               Begin DoDot:1

 +8       ; loop variable for exam type

                   SET DVBAET=0

 +9                FOR

                       SET DVBAET=$ORDER(^DVB(396.4,"APE",DFN,DVBAET))

                       if DVBAET=""

                           QUIT

                       Begin DoDot:2

 +10      ; loop variable for request date

                           SET DVBARD=0

 +11                       FOR

                               SET DVBARD=$ORDER(^DVB(396.4,"APE",DFN,DVBAET,DVBARD))

                               if 'DVBARD

                                   QUIT

                               Begin DoDot:3

 +12                               SET DA=$ORDER(^DVB(396.4,"APE",DFN,DVBAET,DVBARD,0))

 +13                               SET DVBA0ND=$GET(^DVB(396.4,+DA,0))

                                   SET DVBAD=0

 +14                               IF $GET(^DVB(396.6,+$ORDER(^DVB(396.6,"B",$EXTRACT(DVBAET,1,30),0)),0))']""

                                       SET DVBAD=1

 +15      ; exam doesn't exist or event type name is bad

                                   IF DVBA0ND']""!DVBAD

                                       Begin DoDot:4

 +16                                       SET DVBACT=DVBACT+1

 +17                                       DO LINE(DVBACT,DA_"^"_DFN_"^"_DVBARD_"^"_DVBAET)

 +18      ; don't cleanup

                                           IF $GET(DVBAKILL)="NO"

                                               QUIT

 +19                                       KILL ^DVB(396.4,"APE",DFN,DVBAET,DVBARD,DA)

 +20      ; reindex entry (sets only)

                                           IF DVBA0ND]""

                                               DO IX1^DIK

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +21       IF DVBACT=3

               SET DVBACT=DVBACT+1

               DO LINE(DVBACT,"No bad APE x-refs found!")

 +22       DO LINE(DVBACT+1,"End Time:  "_$$NOW^XLFDT())

 +23       IF $GET(DVBAKILL)="NO"

               DO LINE(DVBACT+2,"NOTHING WAS KILLED!!  D EN^DVBAYAPE TO HAVE KILLS EXECUTED")

 +24       KILL DA,DFN,DIK,DVBA0ND,DVBACT,DVBAD,DVBAET,DVBARD

 +25       QUIT

 +26      ;

 +27      ;

LINE(NUMBER,TEXT) ; set data into TMP global for e-mail message

 +1        SET ^TMP("DVBA*2.7*4",$JOB,NUMBER)=TEXT

 +2        QUIT

 +3       ;

 +4       ;

MAIL      ; mail message of results

 +1        NEW DIFROM

 +2        SET XMSUB="DVBA*2.7*4 "_$SELECT($GET(DVBAKILL)'="NO":"Cleanup",1:"Diagnostic")_" has run"

 +3        SET XMTEXT="^TMP(""DVBA*2.7*4"",$J,"

 +4        SET XMY(DUZ)=""

           SET XMDUZ=.5

 +5        DO ^XMD

 +6        KILL XMDUZ,XMSUB,XMTEXT,XMY

 +7        QUIT

 +8       ;

 +9       ;

NOKILL    ; don't kill anything

 +1        SET DVBAKILL="NO"

 +2        DO EN

 +3        KILL DVBAKILL

 +4        QUIT

DVBAYAPE.m