ORY195A ;SLC/DAN Post-install for patch 195 ;10/7/04 11:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
;
;DBIA SECTION
;10063 - %ZTLOAD
;10141 - XPDUTL
;10070 - XMD
;10035 - ^DPT("CN" references
;10061 - VADPT
;
Q ;Entry point to queue process during install
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
S ZTRTN="DQ^ORY195A",ZTDESC="OR*3*195 LAB CHILD ORDER CHECK ROUTINE",ZTIO="",ZTDTH=$H
D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^ORY195A AFTER INSTALL FINISHES") Q
D BMES^XPDUTL("Lab Child Order Check queued as task # "_$G(ZTSK))
Q
;
DQ ;
D SRCH,MAIL
Q
;
SRCH ;Search for lab orders without locations
N LAB,LOC,IEN,CHD,ORD,SUB,ORLIST
K ^TMP($J,"TEXT"),^TMP($J,"ERR")
S LAB=$O(^ORD(100.98,"B","LAB",0)) Q:'+LAB ;quit if no lab display group
S LOC="" F S LOC=$O(^DPT("CN",LOC)) Q:LOC="" S IEN=0 F S IEN=$O(^DPT("CN",LOC,IEN)) Q:'+IEN D
.K ^TMP("ORR",$J)
.D EN^ORQ1(IEN_";DPT(",LAB,2) ;Get active lab orders
.S SUB=0 F S SUB=$O(^TMP("ORR",$J,ORLIST,SUB)) Q:'+SUB S ORD=+^(SUB) I $D(^OR(100,ORD,2)) D
..I '$P(^OR(100,ORD,0),U,17) Q ;Quit if not delayed order
..S CHD=0 F S CHD=$O(^OR(100,ORD,2,CHD)) Q:'+CHD I $P(^OR(100,CHD,0),U,10)="" S ^TMP($J,"ERR",LOC,CHD)=+$P(^OR(100,CHD,0),U,2)
K ^TMP("ORR",$J),^TMP($J,"TEXT")
Q
;
MAIL ;Send message with findings
N CNT,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,LOC,ORD,DFN,VADM
S CNT=1
S ^TMP($J,"TEXT",CNT)="The search for active lab orders without a location has finished.",CNT=CNT+1
S ^TMP($J,"TEXT",CNT)="",CNT=CNT+1
I '$D(^TMP($J,"ERR")) S ^TMP($J,"TEXT",CNT)="No problems were found so no additional work is required.",CNT=CNT+1
I $D(^TMP($J,"ERR")) D
.S ^TMP($J,"TEXT",CNT)="Complex lab orders (e.g. CBC Q12Hx3) that were delayed were not being",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="assigned a location upon release. As a result, the lab orders were not",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="appearing on the lab collection lists.",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="The following patients have active lab orders without a location.",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="It is very likely that these tests have not been done. Please review",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="each order to ensure that the test has been done. You may need to DC the",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="existing order and enter a new order so the test appears on the",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="collection list.",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="",CNT=CNT+1
.S ^TMP($J,"TEXT",CNT)="Please note that existing delayed complex lab orders will release correctly.",CNT=CNT+1
.S LOC="" F S LOC=$O(^TMP($J,"ERR",LOC)) Q:LOC="" S ^TMP($J,"TEXT",CNT)="",CNT=CNT+1,^TMP($J,"TEXT",CNT)="Location: "_LOC,CNT=CNT+1,^(CNT)="",CNT=CNT+1 S ORD=0 F S ORD=$O(^TMP($J,"ERR",LOC,ORD)) Q:'+ORD D
..K VADM
..S DFN=^TMP($J,"ERR",LOC,ORD)
..D DEM^VADPT
..S ^TMP($J,"TEXT",CNT)=VADM(1)_" ("_$E(+VADM(2),6,9)_") ORDER #: "_ORD,CNT=CNT+1,^TMP($J,"TEXT",CNT)=" ORDER TEXT: "_$G(^OR(100,ORD,8,1,.1,1,0)),CNT=CNT+1
S XMDUZ="PATCH OR*3*195 LAB CHILD ORDERS CHECK",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S XMTEXT="^TMP($J,""TEXT"",",XMSUB="PATCH OR*3*195 Lab Order Check COMPLETED"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY195A 3267 printed Sep 23, 2025@20:15:22 Page 2
ORY195A ;SLC/DAN Post-install for patch 195 ;10/7/04 11:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
+2 ;
+3 ;DBIA SECTION
+4 ;10063 - %ZTLOAD
+5 ;10141 - XPDUTL
+6 ;10070 - XMD
+7 ;10035 - ^DPT("CN" references
+8 ;10061 - VADPT
+9 ;
Q ;Entry point to queue process during install
+1 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+2 SET ZTRTN="DQ^ORY195A"
SET ZTDESC="OR*3*195 LAB CHILD ORDER CHECK ROUTINE"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+3 DO ^%ZTLOAD
IF '$GET(ZTSK)
DO BMES^XPDUTL("POST INSTALL NOT QUEUED - RUN DQ^ORY195A AFTER INSTALL FINISHES")
QUIT
+4 DO BMES^XPDUTL("Lab Child Order Check queued as task # "_$GET(ZTSK))
+5 QUIT
+6 ;
DQ ;
+1 DO SRCH
DO MAIL
+2 QUIT
+3 ;
SRCH ;Search for lab orders without locations
+1 NEW LAB,LOC,IEN,CHD,ORD,SUB,ORLIST
+2 KILL ^TMP($JOB,"TEXT"),^TMP($JOB,"ERR")
+3 ;quit if no lab display group
SET LAB=$ORDER(^ORD(100.98,"B","LAB",0))
if '+LAB
QUIT
+4 SET LOC=""
FOR
SET LOC=$ORDER(^DPT("CN",LOC))
if LOC=""
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^DPT("CN",LOC,IEN))
if '+IEN
QUIT
Begin DoDot:1
+5 KILL ^TMP("ORR",$JOB)
+6 ;Get active lab orders
DO EN^ORQ1(IEN_";DPT(",LAB,2)
+7 SET SUB=0
FOR
SET SUB=$ORDER(^TMP("ORR",$JOB,ORLIST,SUB))
if '+SUB
QUIT
SET ORD=+^(SUB)
IF $DATA(^OR(100,ORD,2))
Begin DoDot:2
+8 ;Quit if not delayed order
IF '$PIECE(^OR(100,ORD,0),U,17)
QUIT
+9 SET CHD=0
FOR
SET CHD=$ORDER(^OR(100,ORD,2,CHD))
if '+CHD
QUIT
IF $PIECE(^OR(100,CHD,0),U,10)=""
SET ^TMP($JOB,"ERR",LOC,CHD)=+$PIECE(^OR(100,CHD,0),U,2)
End DoDot:2
End DoDot:1
+10 KILL ^TMP("ORR",$JOB),^TMP($JOB,"TEXT")
+11 QUIT
+12 ;
MAIL ;Send message with findings
+1 NEW CNT,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,LOC,ORD,DFN,VADM
+2 SET CNT=1
+3 SET ^TMP($JOB,"TEXT",CNT)="The search for active lab orders without a location has finished."
SET CNT=CNT+1
+4 SET ^TMP($JOB,"TEXT",CNT)=""
SET CNT=CNT+1
+5 IF '$DATA(^TMP($JOB,"ERR"))
SET ^TMP($JOB,"TEXT",CNT)="No problems were found so no additional work is required."
SET CNT=CNT+1
+6 IF $DATA(^TMP($JOB,"ERR"))
Begin DoDot:1
+7 SET ^TMP($JOB,"TEXT",CNT)="Complex lab orders (e.g. CBC Q12Hx3) that were delayed were not being"
SET CNT=CNT+1
+8 SET ^TMP($JOB,"TEXT",CNT)="assigned a location upon release. As a result, the lab orders were not"
SET CNT=CNT+1
+9 SET ^TMP($JOB,"TEXT",CNT)="appearing on the lab collection lists."
SET CNT=CNT+1
+10 SET ^TMP($JOB,"TEXT",CNT)=""
SET CNT=CNT+1
+11 SET ^TMP($JOB,"TEXT",CNT)="The following patients have active lab orders without a location."
SET CNT=CNT+1
+12 SET ^TMP($JOB,"TEXT",CNT)="It is very likely that these tests have not been done. Please review"
SET CNT=CNT+1
+13 SET ^TMP($JOB,"TEXT",CNT)="each order to ensure that the test has been done. You may need to DC the"
SET CNT=CNT+1
+14 SET ^TMP($JOB,"TEXT",CNT)="existing order and enter a new order so the test appears on the"
SET CNT=CNT+1
+15 SET ^TMP($JOB,"TEXT",CNT)="collection list."
SET CNT=CNT+1
+16 SET ^TMP($JOB,"TEXT",CNT)=""
SET CNT=CNT+1
+17 SET ^TMP($JOB,"TEXT",CNT)="Please note that existing delayed complex lab orders will release correctly."
SET CNT=CNT+1
+18 SET LOC=""
FOR
SET LOC=$ORDER(^TMP($JOB,"ERR",LOC))
if LOC=""
QUIT
SET ^TMP($JOB,"TEXT",CNT)=""
SET CNT=CNT+1
SET ^TMP($JOB,"TEXT",CNT)="Location: "_LOC
SET CNT=CNT+1
SET ^(CNT)=""
SET CNT=CNT+1
SET ORD=0
FOR
SET ORD=$ORDER(^TMP($JOB,"ERR",LOC,ORD))
if '+ORD
QUIT
Begin DoDot:2
+19 KILL VADM
+20 SET DFN=^TMP($JOB,"ERR",LOC,ORD)
+21 DO DEM^VADPT
+22 SET ^TMP($JOB,"TEXT",CNT)=VADM(1)_" ("_$EXTRACT(+VADM(2),6,9)_") ORDER #: "_ORD
SET CNT=CNT+1
SET ^TMP($JOB,"TEXT",CNT)=" ORDER TEXT: "_$GET(^OR(100,ORD,8,1,.1,1,0))
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+23 SET XMDUZ="PATCH OR*3*195 LAB CHILD ORDERS CHECK"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+24 SET XMTEXT="^TMP($J,""TEXT"","
SET XMSUB="PATCH OR*3*195 Lab Order Check COMPLETED"
+25 DO ^XMD
+26 QUIT
