- ORWDXVB2 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04 09:31
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17 1997;Build 242
- ;
- ERROR ;Process error
- D LN
- S VBERROR=$P(ORX("ERROR"),"^",2)
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* WARNING! *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* An Error occurred attempting to *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* retrieve Blood Bank order data. *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* This order cannot be completed at this time. *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Revert to local downtime procedures to continue *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* order or retry this option at a later time. *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Contact the Blood Bank System Administrator *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* Error Message *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
- I $L(VBERROR)<68 D
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(VBERROR)/2,CCNT,VBERROR,.CCNT)
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
- I $L(VBERROR)>68 D
- . I $L(VBERROR)>136 S VBERROR=$E(VBERROR,1,136)_"..."
- . N L1 S L1=$E(VBERROR,1,$L(VBERROR)/2)
- . I $E(L1,$L(L1))'=" " D
- . . S LINE1=$E(L1,1,($L(L1)-($L($P(L1," ",$L(L1," ")))))),LINE2=$E(VBERROR,$L(LINE1)+1,$L(VBERROR))
- . E S LINE1=$E(L1),LINE2=$E(VBERROR,$L(LINE1)+1,$L(VBERROR))
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(LINE1)/2,CCNT,LINE1,.CCNT)
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
- . S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(70-$L(LINE2)/2,CCNT,LINE2,.CCNT)
- . S ^TMP("ORVBEC",$J,GCNT,0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT) D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(2,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 SDATE=$S($D(SDATE):SDATE,1:$$FMADD^XLFDT(DT-ORTNSB))
- S EDATE=$S($D(EDATE):EDATE,1:DT) ;Default to DT if no End date passed in
- 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,19 D ;Get completed, active/pending, unreleased
- . K ^TMP("ORR",$J)
- . D EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE)
- . 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)
- .. 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
- ORWDXVB2 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04 09:31
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243**;Dec 17 1997;Build 242
- +2 ;
- ERROR ;Process error
- +1 DO LN
- +2 SET VBERROR=$PIECE(ORX("ERROR"),"^",2)
- +3 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT)
- DO LN
- +4 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +5 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* WARNING! *",.CCNT)
- DO LN
- +6 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +7 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* An Error occurred attempting to *",.CCNT)
- DO LN
- +8 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* retrieve Blood Bank order data. *",.CCNT)
- DO LN
- +9 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +10 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* This order cannot be completed at this time. *",.CCNT)
- DO LN
- +11 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* Revert to local downtime procedures to continue *",.CCNT)
- DO LN
- +12 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* order or retry this option at a later time. *",.CCNT)
- DO LN
- +13 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +14 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* Contact the Blood Bank System Administrator *",.CCNT)
- DO LN
- +15 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +16 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT)
- DO LN
- +17 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +18 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* Error Message *",.CCNT)
- DO LN
- +19 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +20 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
- +21 IF $LENGTH(VBERROR)<68
- Begin DoDot:1
- +22 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(70-$LENGTH(VBERROR)/2,CCNT,VBERROR,.CCNT)
- +23 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT)
- DO LN
- End DoDot:1
- +24 IF $LENGTH(VBERROR)>68
- Begin DoDot:1
- +25 IF $LENGTH(VBERROR)>136
- SET VBERROR=$EXTRACT(VBERROR,1,136)_"..."
- +26 NEW L1
- SET L1=$EXTRACT(VBERROR,1,$LENGTH(VBERROR)/2)
- +27 IF $EXTRACT(L1,$LENGTH(L1))'=" "
- Begin DoDot:2
- +28 SET LINE1=$EXTRACT(L1,1,($LENGTH(L1)-($LENGTH($PIECE(L1," ",$LENGTH(L1," "))))))
- SET LINE2=$EXTRACT(VBERROR,$LENGTH(LINE1)+1,$LENGTH(VBERROR))
- End DoDot:2
- +29 IF '$TEST
- SET LINE1=$EXTRACT(L1)
- SET LINE2=$EXTRACT(VBERROR,$LENGTH(LINE1)+1,$LENGTH(VBERROR))
- +30 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(70-$LENGTH(LINE1)/2,CCNT,LINE1,.CCNT)
- +31 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT)
- DO LN
- +32 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"*",.CCNT)
- +33 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(70-$LENGTH(LINE2)/2,CCNT,LINE2,.CCNT)
- +34 SET ^TMP("ORVBEC",$JOB,GCNT,0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(67,CCNT,"*",.CCNT)
- DO LN
- End DoDot:1
- +35 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"* *",.CCNT)
- DO LN
- +36 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(2,CCNT,"******************************************************************",.CCNT)
- DO LN
- +37 DO LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM)
- DO LN
- +38 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 SET SDATE=$SELECT($DATA(SDATE):SDATE,1:$$FMADD^XLFDT(DT-ORTNSB))
- +11 ;Default to DT if no End date passed in
- SET EDATE=$SELECT($DATA(EDATE):EDATE,1:DT)
- +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, unreleased
- FOR FLG=4,23,19
- Begin DoDot:1
- +16 KILL ^TMP("ORR",$JOB)
- +17 DO EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE)
- +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 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")
- +24 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:"")
- +25 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
- +26 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
- +27 QUIT
- LN ;Increment counts
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT
