- 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 Mar 13, 2025@21:44:02 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
