1 | ORWDXVB2 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04 09:31
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17 1997;Build 242
|
---|
3 | ;
|
---|
4 | ERROR ;Process error
|
---|
5 | D LN
|
---|
6 | S VBERROR=$P(ORX("ERROR"),"^",2)
|
---|
7 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT) D LN
|
---|
8 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
9 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* WARNING! *",.CCNT) D LN
|
---|
10 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
11 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* An Error occurred attempting to *",.CCNT) D LN
|
---|
12 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* retrieve Blood Bank order data. *",.CCNT) D LN
|
---|
13 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
14 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* This order cannot be completed at this time. *",.CCNT) D LN
|
---|
15 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Revert to local downtime procedures to continue *",.CCNT) D LN
|
---|
16 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* order or retry this option at a later time. *",.CCNT) D LN
|
---|
17 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
18 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Contact the Blood Bank System Administrator *",.CCNT) D LN
|
---|
19 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
20 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT) D LN
|
---|
21 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
22 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Error Message *",.CCNT) D LN
|
---|
23 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
24 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
|
---|
25 | I $L(VBERROR)<68 D
|
---|
26 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(VBERROR)/2,CCNT,VBERROR,.CCNT)
|
---|
27 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
|
---|
28 | I $L(VBERROR)>68 D
|
---|
29 | . I $L(VBERROR)>136 S VBERROR=$E(VBERROR,1,136)_"..."
|
---|
30 | . N L1 S L1=$E(VBERROR,1,$L(VBERROR)/2)
|
---|
31 | . I $E(L1,$L(L1))'=" " D
|
---|
32 | . . S LINE1=$E(L1,1,($L(L1)-($L($P(L1," ",$L(L1," ")))))),LINE2=$E(VBERROR,$L(LINE1)+1,$L(VBERROR))
|
---|
33 | . E S LINE1=$E(L1),LINE2=$E(VBERROR,$L(LINE1)+1,$L(VBERROR))
|
---|
34 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(LINE1)/2,CCNT,LINE1,.CCNT)
|
---|
35 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
|
---|
36 | . S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
|
---|
37 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(LINE2)/2,CCNT,LINE2,.CCNT)
|
---|
38 | . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
|
---|
39 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
|
---|
40 | S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT) D LN
|
---|
41 | D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
|
---|
42 | Q
|
---|
43 | PULL(OROOT,ORVP,ITEMID,SDATE,EDATE) ;Get list of orders matching ITEM
|
---|
44 | ;ITEM = Orderable Item ID e.g. "1;99VBC" for Type and Screen
|
---|
45 | ;SDATE = Start Date for search
|
---|
46 | ;EDATE = End Date for search
|
---|
47 | Q:'$G(ORVP)
|
---|
48 | N ORTNSB
|
---|
49 | I $P(ORVP,";",2)="" S ORVP=ORVP_";DPT("
|
---|
50 | S ORTNSB=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
|
---|
51 | S:'ORTNSB ORTNSB=3 ;Use Default of DT-3 or Parameter [ORWDXVB VBECS TNS CHECK] if no start date passed in
|
---|
52 | S ITEMID=$S($D(ITEMID):ITEMID,1:"1;99VBC") ;Default to Type and Screen if nothing passed in
|
---|
53 | S SDATE=$S($D(SDATE):SDATE,1:$$FMADD^XLFDT(DT-ORTNSB))
|
---|
54 | S EDATE=$S($D(EDATE):EDATE,1:DT) ;Default to DT if no End date passed in
|
---|
55 | N ORDG,FLG,ORLIST,ORX0,ORX3,ORSTAT,ORIFN,I,X,J,CNT,ITEM,ITEMNM,ORLOC,DIV
|
---|
56 | S ITEM=+$O(^ORD(101.43,"ID",ITEMID,0)),ITEMNM=$P($G(^ORD(101.43,ITEM,0)),"^")
|
---|
57 | S CNT=0,ORDG=$O(^ORD(100.98,"B","VBEC",0)) Q:'ORDG
|
---|
58 | F FLG=4,23,19 D ;Get completed, active/pending, unreleased
|
---|
59 | . K ^TMP("ORR",$J)
|
---|
60 | . D EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE)
|
---|
61 | . I '$O(^TMP("ORR",$J,ORLIST,0)) Q
|
---|
62 | . S I=0
|
---|
63 | . F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I S X=^(I) D
|
---|
64 | .. S ORIFN=+X,J=0,DIV=""
|
---|
65 | .. Q:'$D(^OR(100,ORIFN,0)) S ORX0=^(0),ORX3=^(3)
|
---|
66 | .. 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")
|
---|
67 | .. 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:"")
|
---|
68 | .. 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
|
---|
69 | ... S CNT=CNT+1,OROOT(CNT)="Duplicate order: "_ITEMNM_" entered "_$$FMTE^XLFDT($P(ORX0,"^",7))_" Div/Loc: "_DIV_":"_ORLOC_" ["_ORSTAT_"]"
|
---|
70 | Q
|
---|
71 | LN ;Increment counts
|
---|
72 | S GCNT=GCNT+1,CCNT=1
|
---|
73 | Q
|
---|