ORWDXVB2.m

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