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

ORCSEND2.m

Go to the documentation of this file.
  1. ORCSEND2 ;SLC/MKB - Release cont ;Jan 23, 2019@17:18
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,332,503**;Dec 17, 1997;Build 6
  1. ;
  1. PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
  1. Q +$O(^ORD(101.41,"AB","OR GTX "_NAME,0))
  1. ;
  1. EN ; -- Spawn child orders from ORIFN, send to VBECS [from VBEC^ORCSEND1]
  1. N ORPARENT,OR0,ORDIALOG,ORNP,ORDUZ,ORLOG,ORCAT,ORTS,ORDG,ORPKG,ORPRINT
  1. N ORESP,ORTIME,ORSTRT,ORI,ORIT,ORITX,ORFLDS,ORP,P,ORCHLD,ORLAST,X,STS,ORLAB,ORLRIFN
  1. N ORPITEM,ORPRBCM,ORPUNIT,ORPDTW,ORPREAS,ORPMSBS,ORPINFC,ORPURG,ORPTYPE,ORPCOLL,ORPCOMM,ORPRSLT,ORPSPEC,ORPLAB
  1. S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORIFN,0))
  1. S ORDIALOG=+$P(OR0,U,5),ORNP=+$P(OR0,U,4),ORDUZ=+$P(OR0,U,6)
  1. S ORLOG=$P(OR0,U,7),ORCAT=$P(OR0,U,12),ORTS=$P(OR0,U,13)
  1. S ORDG=+$P(OR0,U,11),ORPKG=$P(OR0,U,14),ORPRINT=0
  1. D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(ORIFN,"ORESP"),GETIMES^ORCDLR1
  1. M ^TMP($J,"ORVBDLG")=ORDIALOG S ORPITEM=$$PTR("ORDERABLE ITEM")
  1. S ORPRBCM=$$PTR("RBC MODIFIERS"),ORPUNIT=$$PTR("AMOUNT")
  1. S ORPDTW=$$PTR("DATE/TIME"),ORPREAS=$$PTR("REASON")
  1. S ORPMSBS=$$PTR("TEXT"),ORPINFC=$$PTR("YES/NO")
  1. S ORPTYPE=$$PTR("COLLECTION TYPE"),ORPCOLL=$$PTR("START DATE/TIME")
  1. S ORPURG=$$PTR("URGENCY"),ORPCOMM=$$PTR("FREE TEXT 1")
  1. S ORPSPEC=$$PTR("SPECIMEN STATUS"),ORPRSLT=$$PTR("RESULTS")
  1. S ORPLAB=$$PTR("LAB ORDER") D START ;resolve ORSTRT dates
  1. EN1 S ORI=0 F S ORI=$O(ORESP(ORPITEM,ORI)) Q:ORI<1 D Q:$G(ORERR)
  1. . N ORL S ORL=$P(OR0,U,10) ;protect ORL from calling routine
  1. . S ORIT=+$G(ORESP(ORPITEM,ORI)),ORITX=$G(^ORD(101.43,ORIT,"VB"))
  1. . D LABTST I $G(ORERR) D CANCEL(ORPARENT,$P(ORERR,U,2)) Q
  1. . K ORDIALOG M ORDIALOG=^TMP($J,"ORVBDLG") S ORDIALOG(ORPITEM,1)=ORIT
  1. . S ORFLDS=$S(ORITX:"ORPRBCM^ORPUNIT^ORPSPEC^ORPMSBS^ORPINFC",$P(ORITX,U,2)=1:"ORPTYPE^ORPCOLL",$P(ORITX,U,2)=2:"ORPMSBS^ORPINFC^ORPTYPE^ORPCOLL",1:"")_"^ORPDTW^ORPREAS^ORPURG^ORPCOMM"
  1. . F ORP=1:1:$L(ORFLDS,U) S P=$P(ORFLDS,U,ORP) Q:'$L(P) S ORDIALOG(@P,1)=$S($D(ORESP(@P,ORI)):ORESP(@P,ORI),P="ORPRBCM":"",1:$G(ORESP(@P,1))) ;set values
  1. . S:$G(ORLRIFN) ORDIALOG(ORPLAB,1)=ORLRIFN
  1. . K ORIFN,ORIT D EN^ORCSAVE
  1. . I '$G(ORIFN) S ORERR="1^Unable to create order" Q
  1. . S X=ORSTRT($S(ORITX:"DTW",1:"COLL")) D DATES^ORCSAVE2(ORIFN,X)
  1. . D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)),LINK
  1. . D NW^ORMBLDVB(ORIFN)
  1. S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
  1. D RELEASE^ORCSAVE2(ORPARENT,1,ORNOW,DUZ,$G(NATURE))
  1. ;D STATUS^ORCSAVE2(ORPARENT,5) ;testing
  1. S ORIFN=ORPARENT,ORQUIT=1,STS=$P(^OR(100,ORIFN,3),U,3)
  1. EN2 I STS'=11,STS'=13 D ;successful
  1. . D RESULTS^ORMBLDVB(ORPARENT)
  1. . Q:'$O(ORPRINT(0)) N PAT,LOC,NATR
  1. . S PAT=$P(OR0,U,2),LOC=$S($G(ORL):ORL,1:$P(OR0,U,10))
  1. . S NATR=$$WORK^ORCSIGN($G(NATURE))
  1. . D PRINT^ORPR02(PAT,.ORPRINT,,LOC,"0^1^1^1^"_NATR) ;labels/req's
  1. I $$UNRL(ORPARENT) S ORERR="1^Unable to release order due to an HL7 network error: queued for delivery to VBECS"
  1. I STS=13 S ORERR="1^This order was rejected by VBECS and will NOT be acted upon: see the Order Details for more information and contact the Blood Bank for assistance!"
  1. K ^TMP($J,"ORVBDLG"),^TMP($J,"ORLRDLG")
  1. Q
  1. ;
  1. UNRL(DAD) ; -- ck for any unreleased child orders
  1. N Y,I,STS S Y=0
  1. S I=0 F S I=+$O(^OR(100,+$G(DAD),2,I)) Q:I<1 D Q:Y
  1. . S STS=$P($G(^OR(100,I,3)),U,3)
  1. . I STS=10!(STS=11) S Y=1 Q
  1. Q Y
  1. ;
  1. START ; -- Define ORSTRT(), set Start Date in ORPARENT
  1. N X,Y,%DT,STRT S ORSTRT("COLL")="",ORSTRT("DTW")="",%DT="TX",STRT=""
  1. S X=$G(ORESP(ORPDTW,1)) I $L(X) D ^%DT S:Y>0 ORSTRT("DTW")=Y,STRT=Y
  1. S X=$G(ORESP(ORPCOLL,1)) I $L(X) D
  1. . D AM^ORCSAVE2:X="AM",NEXT^ORCSAVE2:X="NEXT" ;return X
  1. . D ^%DT S:Y>0 ORSTRT("COLL")=Y,STRT=Y
  1. I '$P(OR0,U,8) D DATES^ORCSAVE2(+ORIFN,STRT)
  1. Q
  1. ;
  1. ; Uses ORVP,ORLOG in xref
  1. S ORCHLD=+$G(ORCHLD)+1,^OR(100,ORPARENT,2,ORIFN,0)=ORIFN,ORLAST=ORIFN
  1. S $P(^OR(100,ORIFN,3),U,8,9)="1^"_ORPARENT
  1. S $P(^OR(100,ORIFN,8,1,0),U,4)=8 K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;signature on parent only
  1. Q
  1. ;
  1. LABTST ; -- Create Lab order for VBECS blood component or test
  1. ; Expects var's from above, Returns ORLAB & ORLRIFN
  1. N ORDIALOG,ORDG,ORPKG,ORIFN,X,P,LRT K ORLAB,ORLRIFN
  1. I $G(^TMP($J,"ORLRDLG")) M ORDIALOG=^TMP($J,"ORLRDLG")
  1. E D ;build for now, later reuse
  1. . S ORDIALOG=+$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0))
  1. . D GETDLG1^ORCD(ORDIALOG) M ^TMP($J,"ORLRDLG")=ORDIALOG
  1. S ORDG=+$O(^ORD(100.98,"B","BB",0)),X=$P($G(^ORD(101.43,ORIT,0)),U,8)
  1. S X=+$$TEST(X) I X<1 S ORERR="1^Missing or invalid Lab workload test" Q
  1. S ORDIALOG(ORPITEM,1)=X,LRT=+$P($G(^ORD(101.43,X,0)),U,2)
  1. S ORDIALOG(ORPTYPE,1)=$S($D(ORESP(ORPTYPE,1)):ORESP(ORPTYPE,1),1:"SP")
  1. S ORDIALOG(ORPCOLL,1)=$S($D(ORESP(ORPCOLL,1)):ORESP(ORPCOLL,1),1:$G(ORESP(ORPDTW,1)))
  1. LT1 ; VALIDATE??
  1. S X=+$O(^LAB(60,LRT,3,0)),X=+$G(^(X,0)) ;default/unique sample
  1. S ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=X
  1. S:'ORITX ORDIALOG($$PTR("SPECIMEN"),1)=$P($G(^LAB(62,X,0)),U,2)
  1. S X=+$G(ORESP(ORPURG,1)),X=$P($G(^ORD(101.42,X,0)),U)
  1. S X=$S($L(X):+$O(^LAB(62.05,"B",X,0)),1:9) S:'X X=9
  1. S ORDIALOG($$PTR("LAB URGENCY"),1)=X D
  1. . N ORIT D EN^ORCSAVE ;Isolate ORIT before creating child orders
  1. I '$G(ORIFN) S ORERR="1^Unable to create lab order" Q
  1. S X=$S($D(ORSTRT("COLL")):ORSTRT("COLL"),1:$G(ORSTRT("DTW")))
  1. D DATES^ORCSAVE2(ORIFN,X),LINK
  1. D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)),NEW^ORMBLD(ORIFN)
  1. S ORLAB=$G(^OR(100,ORIFN,4))_";"_$G(LRT),ORLRIFN=ORIFN ;for VBECS msg
  1. I '$G(ORLAB) S ORERR="1^"_$$WHY^ORCSEND(ORIFN,1) Q
  1. S ORPRINT=+$G(ORPRINT)+1,ORPRINT(ORPRINT)=ORIFN_";1"
  1. ;D STATUS^ORCSAVE2(ORIFN,5) S ORLAB="ORLAB" ;for testing
  1. ;N ORZTEST S ORZTEST=1 D NEW^ORMBLD(ORIFN) ZW ORZTEST
  1. Q
  1. ;
  1. TEST(X) ; -- find corresponding Lab test for VBECS item X, in #101.43
  1. N NM,I,Y S NM=X_" - LAB",Y=0
  1. S I=0 F S I=+$O(^ORD(101.43,"B",$E(NM,1,30),I)) Q:I<1 I $P($G(^ORD(101.43,I,0)),U,8)=NM S Y=I Q
  1. Q Y
  1. ;
  1. CANCEL(ORDAD,OREASON) ; -- Cancel parent order
  1. Q:'$G(ORDAD) N NATR,NOW,ORCHLD
  1. S ORCHLD=0 F S ORCHLD=+$O(^OR(100,ORDAD,2,ORCHLD)) Q:ORCHLD<1 D
  1. . Q:"^1^2^13^"[(U_$P($G(^OR(100,ORCHLD,3)),U,3)_U) ;already done
  1. . D MSG^ORMBLD(ORCHLD,"CA",OREASON)
  1. S NATR=+$O(^ORD(100.02,"C","X",0)),NOW=+$E($$NOW^XLFDT,1,12)
  1. S ^OR(100,ORDAD,6)=NATR_U_U_NOW_U_U_$G(OREASON),$P(^(8,1,0),U,15)=13 S:$L($G(OREASON)) ^(1)=OREASON
  1. D STATUS^ORCSAVE2(ORDAD,13) ;cancel
  1. Q