ORUQO ;SLC/JLC - SEARCH QOS FOR ; 5/31/17 1:34pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**315,395,382**;Dec 17,1997;Build 15
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference to PXRMD(801.41 is supported by IA #4097
; Reference to DIC(9.4 is supported by IA #2058
Q
;
EN(PKG,OINU,OINA) ; check for quick orders
N CREAT,EXPR,OROIP,ORDUO,S1,S2,A,B,%,ORDG,DIEN,AFIND,TEXT,TYPE,I,ORPKG
D NOW^%DTC S CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0) K ^XTMP("ORUQO",$J),^TMP($J)
S OROI=$P(PKG,";"),ORPKG=$P(PKG,";",2)
K ORDG
I ORPKG="LR" F I="LAB","MI","BB","HEMA","CH","CY","EM" S ORDG=$O(^ORD(100.98,"B",I,"")) I ORDG]"" S ORDG(ORDG)=""
I ORPKG="PS" F I="C RX","CI RX","I RX","IV RX","NV RX","O RX","SPLY","UD RX","RX","TPN" S ORDG=$O(^ORD(100.98,"B",I,"")) I ORDG]"" S ORDG(ORDG)=""
F TYPE="G","E" D
. S DIEN="" F S DIEN=$O(^PXRMD(801.41,"TYPE",TYPE,DIEN)) Q:DIEN'>0 D
.. S TEXT=$P($G(^PXRMD(801.41,DIEN,1)),"^",5)
.. I TEXT[101.41 S ^TMP($J,$P(TEXT,";"))=""
.. S AFIND="" F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
... I AFIND'[101.41 Q
... S ^TMP($J,$P(AFIND,";"))=""
F I="OR GTX ORDERABLE ITEM","OR GTX ADDITIVE" S OROIP(I)=$O(^ORD(101.41,"B",I,""))
S ORD=0
F S ORD=$O(^ORD(101.41,ORD)) Q:'ORD S A=$G(^(ORD,0)) I $P(A,"^",4)="Q" S B=$P(A,"^",5) I B]"" D
. I '$D(ORDG(B)) Q
. F I="OR GTX ORDERABLE ITEM","OR GTX ADDITIVE" S ORDUO="" D
.. F S ORDUO=$O(^ORD(101.41,ORD,6,"D",OROIP(I),ORDUO)) Q:'ORDUO D
... I $G(^ORD(101.41,ORD,6,ORDUO,1))=OROI S ^XTMP("ORUQO",$J,ORD,ORDUO)=$P(A,"^")_"^"_$P(A,"^",3)
I $D(^XTMP("ORUQO",$J)) S ^XTMP("ORUQO",$J,0)=EXPR_"^"_CREAT D SEND
Q
SEND ;Send message
K ORMSG,XMY N OCNT,ORD,A,S1,XMDUZ,XMSUB,XMTEXT,H1,H2,H3
S XMDUZ="CPRS, SEARCH",XMSUB="QUICK ORDER SEARCH",XMTEXT="ORMSG(",XMY(DUZ)="",XMY("G.OR CACS")=""
I ORPKG="LR" S ORMSG(1,0)=" The check of Lab Quick Orders that contain Lab Test",ORMSG(2,0)=" "_OINU_" ("_$G(OINA)_") is complete.",OCNT=1
I ORPKG="PS" S ORMSG(1,0)=" The check of Pharmacy Quick Orders that contain Pharmacy",ORMSG(2,0)=" Orderable Item "_OINU_" ("_$G(OINA)_") is complete.",OCNT=1
S OCNT=OCNT+2,ORMSG(OCNT,0)=" ",ORMSG(OCNT+1,0)=" Here is the list of all quick orders that should be reviewed by your "
S OCNT=OCNT+2,ORMSG(OCNT,0)="Clinical Applications Coordinator or whoever manages CPRS Quick Orders"
S OCNT=OCNT+1,ORMSG(OCNT,0)="at your site.",ORMSG(OCNT+1,0)=" "
S ORD=0,OCNT=OCNT+2,ORMSG(OCNT,0)="Quick Order Name Disable Text Text or Start Date/Time Ancestors/Menus or Reminders"
S OCNT=OCNT+1,ORMSG(OCNT,0)=" "
F S ORD=$O(^XTMP("ORUQO",$J,ORD)) Q:ORD="" S S1=$O(^XTMP("ORUQO",$J,ORD,0)) Q:S1="" S A=^(S1) D
. S OCNT=OCNT+1,ORMSG(OCNT,0)=$E($P(A,"^")_$J(" ",38),1,37)_" "_$E($P(A,"^",2)_$J(" ",38),1,15)_" ",(H1,H2,H3)=""
. I $D(^TMP($J,ORD)) S H2="Used in Clinical Reminders Dialog"
. I $D(^ORD(101.41,"AD",ORD)) S H3="On a menu or in an order set"
. S S1=0 F S S1=$O(^XTMP("ORUQO",$J,ORD,S1)) Q:S1="" S A=^(S1) D
.. S S2=0 F S S2=$O(^XTMP("ORUQO",$J,ORD,S1,S2)) Q:S2="" S A=^(S2) I $TR(A," ")]"" D
... I H1 S OCNT=OCNT+1,ORMSG(OCNT,0)=$J(" ",56)
... S ORMSG(OCNT,0)=ORMSG(OCNT,0)_$E($P(A,"^")_$J(" ",39),1,38)_" ",H1=1
... I H2]"" S ORMSG(OCNT,0)=ORMSG(OCNT,0)_H2 S H2="" Q
... I H3]"" S ORMSG(OCNT,0)=ORMSG(OCNT,0)_H3 S H3=""
. I H2]"" S ORMSG(OCNT,0)=ORMSG(OCNT,0)_H2
. I H3]"" S:$L(ORMSG(OCNT,0))>97 OCNT=OCNT+1,ORMSG(OCNT,0)=$J(" ",97) S ORMSG(OCNT,0)=ORMSG(OCNT,0)_H3
. S OCNT=OCNT+1,ORMSG(OCNT,0)=" "
D ^XMD
Q
CHECKLR(OR60,OR60N) ;
;OR60 is the file 60 IEN that needs to be checked
N ORPT,OROI
S OR60=$G(OR60) Q:OR60=""
S ORPT=OR60_";99LRT" I '$D(^ORD(101.43,"ID",ORPT)) Q ;test is not in a CPRS orderable item
S OROI=$O(^ORD(101.43,"ID",ORPT,"")) Q:OROI=""
D EN(OROI_";LR",OR60,OR60N) Q
CHECKPS(OR507,OR507N) ;
;OR507 is the file 50.7 IEN that needs to be checked
N ORPT,OROI,ORP
S OR507=$G(OR507) Q:OR507=""
S ORPT=OR507_";99PSP" I '$D(^ORD(101.43,"ID",ORPT)) Q ;drug is not in a CPRS orderable item
S OROI=$O(^ORD(101.43,"ID",ORPT,"")) Q:OROI=""
D EN(OROI_";PS",OR507,OR507N)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUQO 4205 printed Apr 09, 2024@21:29:19 Page 2
ORUQO ;SLC/JLC - SEARCH QOS FOR ; 5/31/17 1:34pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**315,395,382**;Dec 17,1997;Build 15
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Reference to PXRMD(801.41 is supported by IA #4097
+5 ; Reference to DIC(9.4 is supported by IA #2058
+6 QUIT
+7 ;
EN(PKG,OINU,OINA) ; check for quick orders
+1 NEW CREAT,EXPR,OROIP,ORDUO,S1,S2,A,B,%,ORDG,DIEN,AFIND,TEXT,TYPE,I,ORPKG
+2 DO NOW^%DTC
SET CREAT=$EXTRACT(%,1,7)
SET EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0)
KILL ^XTMP("ORUQO",$JOB),^TMP($JOB)
+3 SET OROI=$PIECE(PKG,";")
SET ORPKG=$PIECE(PKG,";",2)
+4 KILL ORDG
+5 IF ORPKG="LR"
FOR I="LAB","MI","BB","HEMA","CH","CY","EM"
SET ORDG=$ORDER(^ORD(100.98,"B",I,""))
IF ORDG]""
SET ORDG(ORDG)=""
+6 IF ORPKG="PS"
FOR I="C RX","CI RX","I RX","IV RX","NV RX","O RX","SPLY","UD RX","RX","TPN"
SET ORDG=$ORDER(^ORD(100.98,"B",I,""))
IF ORDG]""
SET ORDG(ORDG)=""
+7 FOR TYPE="G","E"
Begin DoDot:1
+8 SET DIEN=""
FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",TYPE,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+9 SET TEXT=$PIECE($GET(^PXRMD(801.41,DIEN,1)),"^",5)
+10 IF TEXT[101.41
SET ^TMP($JOB,$PIECE(TEXT,";"))=""
+11 SET AFIND=""
FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
if AFIND=""
QUIT
Begin DoDot:3
+12 IF AFIND'[101.41
QUIT
+13 SET ^TMP($JOB,$PIECE(AFIND,";"))=""
End DoDot:3
End DoDot:2
End DoDot:1
+14 FOR I="OR GTX ORDERABLE ITEM","OR GTX ADDITIVE"
SET OROIP(I)=$ORDER(^ORD(101.41,"B",I,""))
+15 SET ORD=0
+16 FOR
SET ORD=$ORDER(^ORD(101.41,ORD))
if 'ORD
QUIT
SET A=$GET(^(ORD,0))
IF $PIECE(A,"^",4)="Q"
SET B=$PIECE(A,"^",5)
IF B]""
Begin DoDot:1
+17 IF '$DATA(ORDG(B))
QUIT
+18 FOR I="OR GTX ORDERABLE ITEM","OR GTX ADDITIVE"
SET ORDUO=""
Begin DoDot:2
+19 FOR
SET ORDUO=$ORDER(^ORD(101.41,ORD,6,"D",OROIP(I),ORDUO))
if 'ORDUO
QUIT
Begin DoDot:3
+20 IF $GET(^ORD(101.41,ORD,6,ORDUO,1))=OROI
SET ^XTMP("ORUQO",$JOB,ORD,ORDUO)=$PIECE(A,"^")_"^"_$PIECE(A,"^",3)
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF $DATA(^XTMP("ORUQO",$JOB))
SET ^XTMP("ORUQO",$JOB,0)=EXPR_"^"_CREAT
DO SEND
+22 QUIT
SEND ;Send message
+1 KILL ORMSG,XMY
NEW OCNT,ORD,A,S1,XMDUZ,XMSUB,XMTEXT,H1,H2,H3
+2 SET XMDUZ="CPRS, SEARCH"
SET XMSUB="QUICK ORDER SEARCH"
SET XMTEXT="ORMSG("
SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+3 IF ORPKG="LR"
SET ORMSG(1,0)=" The check of Lab Quick Orders that contain Lab Test"
SET ORMSG(2,0)=" "_OINU_" ("_$GET(OINA)_") is complete."
SET OCNT=1
+4 IF ORPKG="PS"
SET ORMSG(1,0)=" The check of Pharmacy Quick Orders that contain Pharmacy"
SET ORMSG(2,0)=" Orderable Item "_OINU_" ("_$GET(OINA)_") is complete."
SET OCNT=1
+5 SET OCNT=OCNT+2
SET ORMSG(OCNT,0)=" "
SET ORMSG(OCNT+1,0)=" Here is the list of all quick orders that should be reviewed by your "
+6 SET OCNT=OCNT+2
SET ORMSG(OCNT,0)="Clinical Applications Coordinator or whoever manages CPRS Quick Orders"
+7 SET OCNT=OCNT+1
SET ORMSG(OCNT,0)="at your site."
SET ORMSG(OCNT+1,0)=" "
+8 SET ORD=0
SET OCNT=OCNT+2
SET ORMSG(OCNT,0)="Quick Order Name Disable Text Text or Start Date/Time Ancestors/Menus or Reminders"
+9 SET OCNT=OCNT+1
SET ORMSG(OCNT,0)=" "
+10 FOR
SET ORD=$ORDER(^XTMP("ORUQO",$JOB,ORD))
if ORD=""
QUIT
SET S1=$ORDER(^XTMP("ORUQO",$JOB,ORD,0))
if S1=""
QUIT
SET A=^(S1)
Begin DoDot:1
+11 SET OCNT=OCNT+1
SET ORMSG(OCNT,0)=$EXTRACT($PIECE(A,"^")_$JUSTIFY(" ",38),1,37)_" "_$EXTRACT($PIECE(A,"^",2)_$JUSTIFY(" ",38),1,15)_" "
SET (H1,H2,H3)=""
+12 IF $DATA(^TMP($JOB,ORD))
SET H2="Used in Clinical Reminders Dialog"
+13 IF $DATA(^ORD(101.41,"AD",ORD))
SET H3="On a menu or in an order set"
+14 SET S1=0
FOR
SET S1=$ORDER(^XTMP("ORUQO",$JOB,ORD,S1))
if S1=""
QUIT
SET A=^(S1)
Begin DoDot:2
+15 SET S2=0
FOR
SET S2=$ORDER(^XTMP("ORUQO",$JOB,ORD,S1,S2))
if S2=""
QUIT
SET A=^(S2)
IF $TRANSLATE(A," ")]""
Begin DoDot:3
+16 IF H1
SET OCNT=OCNT+1
SET ORMSG(OCNT,0)=$JUSTIFY(" ",56)
+17 SET ORMSG(OCNT,0)=ORMSG(OCNT,0)_$EXTRACT($PIECE(A,"^")_$JUSTIFY(" ",39),1,38)_" "
SET H1=1
+18 IF H2]""
SET ORMSG(OCNT,0)=ORMSG(OCNT,0)_H2
SET H2=""
QUIT
+19 IF H3]""
SET ORMSG(OCNT,0)=ORMSG(OCNT,0)_H3
SET H3=""
End DoDot:3
End DoDot:2
+20 IF H2]""
SET ORMSG(OCNT,0)=ORMSG(OCNT,0)_H2
+21 IF H3]""
if $LENGTH(ORMSG(OCNT,0))>97
SET OCNT=OCNT+1
SET ORMSG(OCNT,0)=$JUSTIFY(" ",97)
SET ORMSG(OCNT,0)=ORMSG(OCNT,0)_H3
+22 SET OCNT=OCNT+1
SET ORMSG(OCNT,0)=" "
End DoDot:1
+23 DO ^XMD
+24 QUIT
CHECKLR(OR60,OR60N) ;
+1 ;OR60 is the file 60 IEN that needs to be checked
+2 NEW ORPT,OROI
+3 SET OR60=$GET(OR60)
if OR60=""
QUIT
+4 ;test is not in a CPRS orderable item
SET ORPT=OR60_";99LRT"
IF '$DATA(^ORD(101.43,"ID",ORPT))
QUIT
+5 SET OROI=$ORDER(^ORD(101.43,"ID",ORPT,""))
if OROI=""
QUIT
+6 DO EN(OROI_";LR",OR60,OR60N)
QUIT
CHECKPS(OR507,OR507N) ;
+1 ;OR507 is the file 50.7 IEN that needs to be checked
+2 NEW ORPT,OROI,ORP
+3 SET OR507=$GET(OR507)
if OR507=""
QUIT
+4 ;drug is not in a CPRS orderable item
SET ORPT=OR507_";99PSP"
IF '$DATA(^ORD(101.43,"ID",ORPT))
QUIT
+5 SET OROI=$ORDER(^ORD(101.43,"ID",ORPT,""))
if OROI=""
QUIT
+6 DO EN(OROI_";PS",OR507,OR507N)
+7 QUIT
