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)
Q
;
;
DQ ; dequeue task (or call in direct mode)
D CLEAN
D MAIL
Q
;
;
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
Q
;
;
LINE(NUMBER,TEXT) ; set data into TMP global for e-mail message
S ^TMP("DVBA*2.7*4",$J,NUMBER)=TEXT
Q
;
;
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
Q
;
;
NOKILL ; don't kill anything
S DVBAKILL="NO"
D EN
K DVBAKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAYAPE 2348 printed Nov 22, 2024@16:53:14 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
