LRAPALRT ;DALOI/CKA - SEND AN AP ALERT AFTER THE REPORT HAS BEEN RELEASED ;02/14/11 15:30
;;5.2;LAB SERVICE;**365,315,350**;Sep 27, 1994;Build 230
;
;
EN ; Entry point to send/resend an AP alert to additional recipients
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRA,LRAC,LRADL,LRAU,LRDATA,LRDFN,LRH,LRI,LRIDT,LRJ,LRMSG,LREND,LRMANDO,LRMORE,LRQUIT,LRIENS,LRSF,LRSS,LRXQA,LRZ,XQA,Y
S LRQUIT=0
D SECTION^LRAPRES
I LRQUIT D END Q
D ACCYR^LRAPRES
I LRQUIT D END Q
D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
I LRDATA<1 S LRQUIT=1
I LRQUIT D END Q
;
; CPRS alerts only sent for "patients" related to PATIENT file (#2)
I $P($G(^LR(LRDFN,0)),"^",2)'=2 D Q
. K DIR,DIRUT,DTOUT,DUOUT
. S DIR(0)="E"
. S DIR("A",1)="CPRS does not support alerts for non-PATIENT file (#2) patients."
. S DIR("A")="Press any key to continue"
. D ^DIR
;
I 'LRAU D
. S LRDFN=LRDATA,LRI=LRDATA(1)
. S LRA=^LR(LRDFN,LRSS,LRI,0),LRZ(2)=$P(LRA,"^",11),LRAC=$P(LRA,"^",6)
. I 'LRZ(2) D
. . D EN^DDIOL($C(7)_"Report has not been released. An alert cannot be sent.","","!!")
. . S LRQUIT=1 Q
;
I LRQUIT D END Q
;
I LRAU D
. S LRDFN=LRDATA
. I $G(^LR(LRDFN,"AU"))="" D Q
. . D EN^DDIOL("No information found for this accession in the LAB DATA file (#63).","","!!")
. . S LRQUIT=1 Q
. S LRZ=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
. I 'LRZ D
. . D EN^DDIOL($C(7)_"Report has not been released. An alert cannot be sent.","","!!")
. . S LRQUIT=1 Q
. S LRA=^LR(LRDFN,"AU"),LRI=$P(LRA,U),LRAC=$P(LRA,"^",6)
I LRQUIT D END Q
;
K DIR
S DIR(0)="YO",DIR("A")="Include previous mandatory recipients",DIR("B")="YES"
D ^DIR
I $D(DIRUT) D END Q
;
S LRMANDO=+Y
I LRMANDO D
. N LRC,LRDOCS
. D GETDOCS^LRAPUTL(.LRDOCS,LRDFN,LRSS,LRIDT,LRSF)
. S LRC=0
. F S LRC=$O(LRDOCS(LRC)) Q:LRC<1 D
. . I $D(XQA(+LRDOCS(LRC))) S XQA(+LRDOCS(LRC))=XQA(+LRDOCS(LRC))_"/"_$P(LRDOCS(LRC),"^",3) Q
. . S XQA(+LRDOCS(LRC))=$P(LRDOCS(LRC),"^",3)
;
D MORE^LRAPRES1
I LRMORE D LOOKUP^LRAPRES1
;
I $D(XQA) D
. K DIR
. S LRJ=0 D CHELP^LRAPRES1
. S DIR(0)="YO",DIR("A")="Send Alert",DIR("B")="YES"
. D ^DIR
. I Y=1 S LRI=LRIDT D ALERT^LRAPRES1
;
END D END^LRAPRES
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPALRT 2225 printed Sep 23, 2025@19:42:30 Page 2
LRAPALRT ;DALOI/CKA - SEND AN AP ALERT AFTER THE REPORT HAS BEEN RELEASED ;02/14/11 15:30
+1 ;;5.2;LAB SERVICE;**365,315,350**;Sep 27, 1994;Build 230
+2 ;
+3 ;
EN ; Entry point to send/resend an AP alert to additional recipients
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRA,LRAC,LRADL,LRAU,LRDATA,LRDFN,LRH,LRI,LRIDT,LRJ,LRMSG,LREND,LRMANDO,LRMORE,LRQUIT,LRIENS,LRSF,LRSS,LRXQA,LRZ,XQA,Y
+2 SET LRQUIT=0
+3 DO SECTION^LRAPRES
+4 IF LRQUIT
DO END
QUIT
+5 DO ACCYR^LRAPRES
+6 IF LRQUIT
DO END
QUIT
+7 DO LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
+8 IF LRDATA<1
SET LRQUIT=1
+9 IF LRQUIT
DO END
QUIT
+10 ;
+11 ; CPRS alerts only sent for "patients" related to PATIENT file (#2)
+12 IF $PIECE($GET(^LR(LRDFN,0)),"^",2)'=2
Begin DoDot:1
+13 KILL DIR,DIRUT,DTOUT,DUOUT
+14 SET DIR(0)="E"
+15 SET DIR("A",1)="CPRS does not support alerts for non-PATIENT file (#2) patients."
+16 SET DIR("A")="Press any key to continue"
+17 DO ^DIR
End DoDot:1
QUIT
+18 ;
+19 IF 'LRAU
Begin DoDot:1
+20 SET LRDFN=LRDATA
SET LRI=LRDATA(1)
+21 SET LRA=^LR(LRDFN,LRSS,LRI,0)
SET LRZ(2)=$PIECE(LRA,"^",11)
SET LRAC=$PIECE(LRA,"^",6)
+22 IF 'LRZ(2)
Begin DoDot:2
+23 DO EN^DDIOL($CHAR(7)_"Report has not been released. An alert cannot be sent.","","!!")
+24 SET LRQUIT=1
QUIT
End DoDot:2
End DoDot:1
+25 ;
+26 IF LRQUIT
DO END
QUIT
+27 ;
+28 IF LRAU
Begin DoDot:1
+29 SET LRDFN=LRDATA
+30 IF $GET(^LR(LRDFN,"AU"))=""
Begin DoDot:2
+31 DO EN^DDIOL("No information found for this accession in the LAB DATA file (#63).","","!!")
+32 SET LRQUIT=1
QUIT
End DoDot:2
QUIT
+33 SET LRZ=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
+34 IF 'LRZ
Begin DoDot:2
+35 DO EN^DDIOL($CHAR(7)_"Report has not been released. An alert cannot be sent.","","!!")
+36 SET LRQUIT=1
QUIT
End DoDot:2
+37 SET LRA=^LR(LRDFN,"AU")
SET LRI=$PIECE(LRA,U)
SET LRAC=$PIECE(LRA,"^",6)
End DoDot:1
+38 IF LRQUIT
DO END
QUIT
+39 ;
+40 KILL DIR
+41 SET DIR(0)="YO"
SET DIR("A")="Include previous mandatory recipients"
SET DIR("B")="YES"
+42 DO ^DIR
+43 IF $DATA(DIRUT)
DO END
QUIT
+44 ;
+45 SET LRMANDO=+Y
+46 IF LRMANDO
Begin DoDot:1
+47 NEW LRC,LRDOCS
+48 DO GETDOCS^LRAPUTL(.LRDOCS,LRDFN,LRSS,LRIDT,LRSF)
+49 SET LRC=0
+50 FOR
SET LRC=$ORDER(LRDOCS(LRC))
if LRC<1
QUIT
Begin DoDot:2
+51 IF $DATA(XQA(+LRDOCS(LRC)))
SET XQA(+LRDOCS(LRC))=XQA(+LRDOCS(LRC))_"/"_$PIECE(LRDOCS(LRC),"^",3)
QUIT
+52 SET XQA(+LRDOCS(LRC))=$PIECE(LRDOCS(LRC),"^",3)
End DoDot:2
End DoDot:1
+53 ;
+54 DO MORE^LRAPRES1
+55 IF LRMORE
DO LOOKUP^LRAPRES1
+56 ;
+57 IF $DATA(XQA)
Begin DoDot:1
+58 KILL DIR
+59 SET LRJ=0
DO CHELP^LRAPRES1
+60 SET DIR(0)="YO"
SET DIR("A")="Send Alert"
SET DIR("B")="YES"
+61 DO ^DIR
+62 IF Y=1
SET LRI=LRIDT
DO ALERT^LRAPRES1
End DoDot:1
+63 ;
END DO END^LRAPRES
+1 QUIT
