ORB3LAB ; slc/CLA/TC - Routine to trigger Lab-related notifications ;10/14/03
;;3.0;ORDER ENTRY/RESULTS REPORTING;**210,243,315**;Dec 17, 1997;Build 20
;
LAB(ORDFN,ORLRDFN,ORLRI,ORLRA,ORLRSS,ORXQA) ;trigger Lab Anatomic Path notifs
; called by SEND^LRAPRES1 (DBIA #4287)
;
N ORBMSG,ORAPMD,ORBADUZ,ORSRPT,ORACCNO
I '$D(ORXQA) D
. S ORAPMD=$S(ORLRSS="AU":$P(ORLRA,U,12),1:$P(ORLRA,U,7)) ;provider/physician "ordering" the ap test
. I $L(ORAPMD) S ORBADUZ(ORAPMD)=""
I $D(ORXQA) M ORBADUZ=ORXQA
S ORSRPT=""
I ORLRSS="AU",$O(^LR(ORLRDFN,84,0)) S ORSRPT=" supplmntl rpt" ;AP supplmntl rpt - DBIA #5157
I ORLRSS'="AU",$G(ORLRI)]"",$O(^LR(ORLRDFN,ORLRSS,ORLRI,1.2,0)) S ORSRPT=" supplmntl rpt" ; AP supplmntl rpt - DBIA #5157
S ORBMSG=$S(ORLRSS="AU":"Autopsy",ORLRSS="CY":"Cytology",ORLRSS="SP":"Surgical Pathology",ORLRSS="EM":"Electron Microscopy",1:"Anatomic Pathology")
S ORBMSG=ORBMSG_ORSRPT_" results available."
S ORACCNO=$P(ORLRA,U,6) ;accession # of lab section
D EN^ORB3(71,ORDFN,"",.ORBADUZ,ORBMSG,ORLRSS_U_ORACCNO_U_ORLRI) ;XQADATA="Lab section^Accession#^DT specimen taken (inverse format)"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3LAB 1138 printed Oct 16, 2024@18:28 Page 2
ORB3LAB ; slc/CLA/TC - Routine to trigger Lab-related notifications ;10/14/03
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**210,243,315**;Dec 17, 1997;Build 20
+2 ;
LAB(ORDFN,ORLRDFN,ORLRI,ORLRA,ORLRSS,ORXQA) ;trigger Lab Anatomic Path notifs
+1 ; called by SEND^LRAPRES1 (DBIA #4287)
+2 ;
+3 NEW ORBMSG,ORAPMD,ORBADUZ,ORSRPT,ORACCNO
+4 IF '$DATA(ORXQA)
Begin DoDot:1
+5 ;provider/physician "ordering" the ap test
SET ORAPMD=$SELECT(ORLRSS="AU":$PIECE(ORLRA,U,12),1:$PIECE(ORLRA,U,7))
+6 IF $LENGTH(ORAPMD)
SET ORBADUZ(ORAPMD)=""
End DoDot:1
+7 IF $DATA(ORXQA)
MERGE ORBADUZ=ORXQA
+8 SET ORSRPT=""
+9 ;AP supplmntl rpt - DBIA #5157
IF ORLRSS="AU"
IF $ORDER(^LR(ORLRDFN,84,0))
SET ORSRPT=" supplmntl rpt"
+10 ; AP supplmntl rpt - DBIA #5157
IF ORLRSS'="AU"
IF $GET(ORLRI)]""
IF $ORDER(^LR(ORLRDFN,ORLRSS,ORLRI,1.2,0))
SET ORSRPT=" supplmntl rpt"
+11 SET ORBMSG=$SELECT(ORLRSS="AU":"Autopsy",ORLRSS="CY":"Cytology",ORLRSS="SP":"Surgical Pathology",ORLRSS="EM":"Electron Microscopy",1:"Anatomic Pathology")
+12 SET ORBMSG=ORBMSG_ORSRPT_" results available."
+13 ;accession # of lab section
SET ORACCNO=$PIECE(ORLRA,U,6)
+14 ;XQADATA="Lab section^Accession#^DT specimen taken (inverse format)"
DO EN^ORB3(71,ORDFN,"",.ORBADUZ,ORBMSG,ORLRSS_U_ORACCNO_U_ORLRI)
+15 QUIT
