ORWDXVB2 ;SLC/DCM - Order dialog utilities for Blood Bank Cont. ;Dec 02, 2021@12:50:32
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,212,309,332,405**;Dec 17 1997;Build 211
;
ERROR(OROOT) ;Process error
N ORERR,ORI,X,Y,I
S VBERROR=$P(ORX("ERROR"),"^",2) D LN
D GETWP^XPAR(.ORERR,"ALL","OR VBECS ERROR MESSAGE")
S ORI=0,Y="" F S ORI=$O(ORERR(ORI)) Q:ORI<1 D
. S Y=$G(ORERR(ORI,0))
. D WRAP^ORU2(.Y,79)
. F I=1:1 S X=$P(Y,"|",I) Q:'$L(X) D
.. S @OROOT@(GCNT,0)=$$S^ORU4($S(I=1:2,1:1),CCNT,X,.CCNT) D LN
D WRAP^ORU2(.VBERROR,77)
I X'?1."*" S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT) D LN
S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* Error Message *",.CCNT) D LN
S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
F I=1:1 S X=$P(VBERROR,"|",I) Q:'$L(X) D
. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"*",.CCNT)
. S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80-$L(X)/2,CCNT,X,.CCNT)
. S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80,CCNT,"*",.CCNT) D LN
S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT) D LN
D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
Q
PULL(OROOT,ORVP,ITEMID,SDATE,EDATE) ;Get list of orders matching ITEM
;ITEM = Orderable Item ID e.g. "1;99VBC" for Type and Screen
;SDATE = Start Date for search
;EDATE = End Date for search
Q:'$G(ORVP)
N ORTNSB
I $P(ORVP,";",2)="" S ORVP=ORVP_";DPT("
S ORTNSB=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
S:'ORTNSB ORTNSB=3 ;Use Default of DT-3 or Parameter [ORWDXVB VBECS TNS CHECK] if no start date passed in
S ITEMID=$S($D(ITEMID):ITEMID,1:"1;99VBC") ;Default to Type and Screen if nothing passed in
S EDATE=$S($G(EDATE):EDATE,1:DT) ;Default to DT if no End date passed in
S SDATE=$S($D(SDATE):SDATE,1:$$FMADD^XLFDT(EDATE,-ORTNSB))
N ORDG,FLG,ORLIST,ORX0,ORX3,ORSTAT,ORIFN,I,X,J,CNT,ITEM,ITEMNM,ORLOC,DIV
S ITEM=+$O(^ORD(101.43,"ID",ITEMID,0)),ITEMNM=$P($G(^ORD(101.43,ITEM,0)),"^")
S CNT=0,ORDG=$O(^ORD(100.98,"B","VBEC",0)) Q:'ORDG
F FLG=4,23 D ;Get completed, active/pending
. K ^TMP("ORR",$J)
. D EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE,,,"AW")
. I '$O(^TMP("ORR",$J,ORLIST,0)) Q
. S I=0
. F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I S X=^(I) D
.. S ORIFN=+X,J=0,DIV=""
.. Q:'$D(^OR(100,ORIFN,0)) S ORX0=^(0),ORX3=^(3)
.. I (($P(ORX3,"^",3)=2)!($P(ORX3,"^",3)=7)),'$L($G(ORX("SPECIMEN"))) Q ;Test completed/expired, yet VBECS doesn't have a specimen
.. S ORSTAT=$S($D(^ORD(100.01,+$P(ORX3,"^",3),0)):$P(^(0),"^"),1:""),ORLOC=$S($L($P($G(^SC(+$P(ORX0,"^",10),0)),"^")):$P(^(0),"^"),1:"UNKNOWN")
.. I +$P(ORX0,"^",10) S DIV=$P($G(^SC(+$P(ORX0,"^",10),0)),U,15),DIV=$S(DIV:$P($$SITE^VASITE(DT,DIV),"^",2),1:"")
.. F S J=$O(^OR(100,ORIFN,4.5,"ID","ORDERABLE",J)) Q:'J I +$G(^OR(100,ORIFN,4.5,J,1))=ITEM D
... S CNT=CNT+1,OROOT(CNT)="Duplicate order: "_ITEMNM_" entered "_$$FMTE^XLFDT($P(ORX0,"^",7))_" Div/Loc: "_DIV_":"_ORLOC_" ["_ORSTAT_"]"
Q
LN ;Increment counts
S GCNT=GCNT+1,CCNT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXVB2 3493 printed Nov 22, 2024@17:46:04 Page 2
ORWDXVB2 ;SLC/DCM - Order dialog utilities for Blood Bank Cont. ;Dec 02, 2021@12:50:32
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,212,309,332,405**;Dec 17 1997;Build 211
+2 ;
ERROR(OROOT) ;Process error
+1 NEW ORERR,ORI,X,Y,I
+2 SET VBERROR=$PIECE(ORX("ERROR"),"^",2)
DO LN
+3 DO GETWP^XPAR(.ORERR,"ALL","OR VBECS ERROR MESSAGE")
+4 SET ORI=0
SET Y=""
FOR
SET ORI=$ORDER(ORERR(ORI))
if ORI<1
QUIT
Begin DoDot:1
+5 SET Y=$GET(ORERR(ORI,0))
+6 DO WRAP^ORU2(.Y,79)
+7 FOR I=1:1
SET X=$PIECE(Y,"|",I)
if '$LENGTH(X)
QUIT
Begin DoDot:2
+8 SET @OROOT@(GCNT,0)=$$S^ORU4($SELECT(I=1:2,1:1),CCNT,X,.CCNT)
DO LN
End DoDot:2
End DoDot:1
+9 DO WRAP^ORU2(.VBERROR,77)
+10 IF X'?1."*"
SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT)
DO LN
+11 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT)
DO LN
+12 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* Error Message *",.CCNT)
DO LN
+13 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT)
DO LN
+14 FOR I=1:1
SET X=$PIECE(VBERROR,"|",I)
if '$LENGTH(X)
QUIT
Begin DoDot:1
+15 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"*",.CCNT)
+16 SET @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80-$LENGTH(X)/2,CCNT,X,.CCNT)
+17 SET @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80,CCNT,"*",.CCNT)
DO LN
End DoDot:1
+18 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT)
DO LN
+19 SET @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT)
DO LN
+20 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
DO LN
+21 QUIT
PULL(OROOT,ORVP,ITEMID,SDATE,EDATE) ;Get list of orders matching ITEM
+1 ;ITEM = Orderable Item ID e.g. "1;99VBC" for Type and Screen
+2 ;SDATE = Start Date for search
+3 ;EDATE = End Date for search
+4 if '$GET(ORVP)
QUIT
+5 NEW ORTNSB
+6 IF $PIECE(ORVP,";",2)=""
SET ORVP=ORVP_";DPT("
+7 SET ORTNSB=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
+8 ;Use Default of DT-3 or Parameter [ORWDXVB VBECS TNS CHECK] if no start date passed in
if 'ORTNSB
SET ORTNSB=3
+9 ;Default to Type and Screen if nothing passed in
SET ITEMID=$SELECT($DATA(ITEMID):ITEMID,1:"1;99VBC")
+10 ;Default to DT if no End date passed in
SET EDATE=$SELECT($GET(EDATE):EDATE,1:DT)
+11 SET SDATE=$SELECT($DATA(SDATE):SDATE,1:$$FMADD^XLFDT(EDATE,-ORTNSB))
+12 NEW ORDG,FLG,ORLIST,ORX0,ORX3,ORSTAT,ORIFN,I,X,J,CNT,ITEM,ITEMNM,ORLOC,DIV
+13 SET ITEM=+$ORDER(^ORD(101.43,"ID",ITEMID,0))
SET ITEMNM=$PIECE($GET(^ORD(101.43,ITEM,0)),"^")
+14 SET CNT=0
SET ORDG=$ORDER(^ORD(100.98,"B","VBEC",0))
if 'ORDG
QUIT
+15 ;Get completed, active/pending
FOR FLG=4,23
Begin DoDot:1
+16 KILL ^TMP("ORR",$JOB)
+17 DO EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE,,,"AW")
+18 IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
QUIT
+19 SET I=0
+20 FOR
SET I=$ORDER(^TMP("ORR",$JOB,ORLIST,I))
if 'I
QUIT
SET X=^(I)
Begin DoDot:2
+21 SET ORIFN=+X
SET J=0
SET DIV=""
+22 if '$DATA(^OR(100,ORIFN,0))
QUIT
SET ORX0=^(0)
SET ORX3=^(3)
+23 ;Test completed/expired, yet VBECS doesn't have a specimen
IF (($PIECE(ORX3,"^",3)=2)!($PIECE(ORX3,"^",3)=7))
IF '$LENGTH($GET(ORX("SPECIMEN")))
QUIT
+24 SET ORSTAT=$SELECT($DATA(^ORD(100.01,+$PIECE(ORX3,"^",3),0)):$PIECE(^(0),"^"),1:"")
SET ORLOC=$SELECT($LENGTH($PIECE($GET(^SC(+$PIECE(ORX0,"^",10),0)),"^")):$PIECE(^(0),"^"),1:"UNKNOWN")
+25 IF +$PIECE(ORX0,"^",10)
SET DIV=$PIECE($GET(^SC(+$PIECE(ORX0,"^",10),0)),U,15)
SET DIV=$SELECT(DIV:$PIECE($$SITE^VASITE(DT,DIV),"^",2),1:"")
+26 FOR
SET J=$ORDER(^OR(100,ORIFN,4.5,"ID","ORDERABLE",J))
if 'J
QUIT
IF +$GET(^OR(100,ORIFN,4.5,J,1))=ITEM
Begin DoDot:3
+27 SET CNT=CNT+1
SET OROOT(CNT)="Duplicate order: "_ITEMNM_" entered "_$$FMTE^XLFDT($PIECE(ORX0,"^",7))_" Div/Loc: "_DIV_":"_ORLOC_" ["_ORSTAT_"]"
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
LN ;Increment counts
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
