Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDXVB2

ORWDXVB2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ERROR(OROOT) ;Process error
  1. N ORERR,ORI,X,Y,I
  1. S VBERROR=$P(ORX("ERROR"),"^",2) D LN
  1. D GETWP^XPAR(.ORERR,"ALL","OR VBECS ERROR MESSAGE")
  1. S ORI=0,Y="" F S ORI=$O(ORERR(ORI)) Q:ORI<1 D
  1. . S Y=$G(ORERR(ORI,0))
  1. . D WRAP^ORU2(.Y,79)
  1. . F I=1:1 S X=$P(Y,"|",I) Q:'$L(X) D
  1. .. S @OROOT@(GCNT,0)=$$S^ORU4($S(I=1:2,1:1),CCNT,X,.CCNT) D LN
  1. D WRAP^ORU2(.VBERROR,77)
  1. I X'?1."*" S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT) D LN
  1. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
  1. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* Error Message *",.CCNT) D LN
  1. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
  1. F I=1:1 S X=$P(VBERROR,"|",I) Q:'$L(X) D
  1. . S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"*",.CCNT)
  1. . S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80-$L(X)/2,CCNT,X,.CCNT)
  1. . S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S^ORU4(80,CCNT,"*",.CCNT) D LN
  1. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"* *",.CCNT) D LN
  1. S @OROOT@(GCNT,0)=$$S^ORU4(1,CCNT,"********************************************************************************",.CCNT) D LN
  1. D LINE^ORU4("^TMP(""ORVBEC"",$J)",GIOM),LN
  1. Q
  1. 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
  1. ;SDATE = Start Date for search
  1. ;EDATE = End Date for search
  1. Q:'$G(ORVP)
  1. N ORTNSB
  1. I $P(ORVP,";",2)="" S ORVP=ORVP_";DPT("
  1. S ORTNSB=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
  1. S:'ORTNSB ORTNSB=3 ;Use Default of DT-3 or Parameter [ORWDXVB VBECS TNS CHECK] if no start date passed in
  1. S ITEMID=$S($D(ITEMID):ITEMID,1:"1;99VBC") ;Default to Type and Screen if nothing passed in
  1. S EDATE=$S($G(EDATE):EDATE,1:DT) ;Default to DT if no End date passed in
  1. S SDATE=$S($D(SDATE):SDATE,1:$$FMADD^XLFDT(EDATE,-ORTNSB))
  1. N ORDG,FLG,ORLIST,ORX0,ORX3,ORSTAT,ORIFN,I,X,J,CNT,ITEM,ITEMNM,ORLOC,DIV
  1. S ITEM=+$O(^ORD(101.43,"ID",ITEMID,0)),ITEMNM=$P($G(^ORD(101.43,ITEM,0)),"^")
  1. S CNT=0,ORDG=$O(^ORD(100.98,"B","VBEC",0)) Q:'ORDG
  1. F FLG=4,23 D ;Get completed, active/pending
  1. . K ^TMP("ORR",$J)
  1. . D EN^ORQ1(ORVP,ORDG,FLG,0,SDATE,EDATE,,,"AW")
  1. . I '$O(^TMP("ORR",$J,ORLIST,0)) Q
  1. . S I=0
  1. . F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:'I S X=^(I) D
  1. .. S ORIFN=+X,J=0,DIV=""
  1. .. Q:'$D(^OR(100,ORIFN,0)) S ORX0=^(0),ORX3=^(3)
  1. .. I (($P(ORX3,"^",3)=2)!($P(ORX3,"^",3)=7)),'$L($G(ORX("SPECIMEN"))) Q ;Test completed/expired, yet VBECS doesn't have a specimen
  1. .. 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")
  1. .. 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:"")
  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
  1. ... S CNT=CNT+1,OROOT(CNT)="Duplicate order: "_ITEMNM_" entered "_$$FMTE^XLFDT($P(ORX0,"^",7))_" Div/Loc: "_DIV_":"_ORLOC_" ["_ORSTAT_"]"
  1. Q
  1. LN ;Increment counts
  1. S GCNT=GCNT+1,CCNT=1
  1. Q