ORB3LAB.m

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 ---ORB3LAB   1138     printed  Apr 09, 2024@21:43:34                                                                                                                                                                                                     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