Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXVB2.m

    r613 r623  
    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
     1ORWDXVB2 ;slc/dcm - Order dialog utilities for Blood Bank Cont.;3/2/04  09:31
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17 1997
     3 ;
     4ERROR ;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
     43LN ;Increment counts
     44 S GCNT=GCNT+1,CCNT=1
     45 Q
Note: See TracChangeset for help on using the changeset viewer.