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

ORMVBEC.m

Go to the documentation of this file.
  1. ORMVBEC ; SLC/MKB - Process VBECS order msgs ;Mar 04, 2019@16:11:47
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212,309,332,405**;Dec 17, 1997;Build 211
  1. ;
  1. EN ; -- entry point for VBEC messages from ORMHLREC
  1. ;M ^MKB(+ORIFN)=@ORMSG ;for testing
  1. I '$L($T(@ORDCNTRL)) Q ;S ORERR="1^Invalid order control code" Q
  1. I '$G(ORIFN)!'$D(^OR(100,+$G(ORIFN),0)) S ORERR="1^Invalid order number" Q
  1. S:$G(ORLOG)<1 ORLOG=+$E($$NOW^XLFDT,1,12)
  1. D @ORDCNTRL
  1. Q
  1. ;
  1. ACK(ORIFN) ; -- process DIRECT^HLMA acknowledgment [from ORMBLDVB]
  1. N ORMSG,I,J,MSH,MSA,ORC,ORTYPE,ORLOG,OREASON,ORNATR,ORDCNTRL,PKGIFN,X
  1. F I=1:1 X HLNEXT Q:HLQUIT'>0 D ;get,parse message from HL7 package
  1. . S ORMSG(I)=HLNODE,J=0 ;Get segment node
  1. . ; Get continuation nodes for long segments, if any
  1. . F S J=$O(HLNODE(J)) Q:'J S ORMSG(I,J)=HLNODE(J)
  1. ;I '$O(ORMSG(0)) D EN^ORERR("Missing HL7 message",.ORMSG) Q
  1. S MSH=0 F S MSH=$O(ORMSG(MSH)) Q:MSH'>0 Q:$E(ORMSG(MSH),1,3)="MSH"
  1. I 'MSH S ORERR="1^Missing or invalid MSH segment" D ERR Q
  1. S MSA=+$O(ORMSG(MSH)) I 'MSA!($E($G(ORMSG(MSA)),1,3)'="MSA") D Q
  1. . S ORERR="1^Missing or invalid MSA segment" D ERR
  1. S ORTYPE=$P(ORMSG(MSH),"|",9),MSA=MSA_U_ORMSG(MSA)
  1. S ORLOG=+$E($$NOW^XLFDT,1,12),OREASON=U_$P(MSA,"|",4),ORNATR=""
  1. I $P(MSA,"|",2)'="AA",'$O(ORMSG(+MSA)) D Q ;unsuccessful, no order#
  1. . S ORERR="1^"_$P(OREASON,U,2) D UA,ERR
  1. S ORC=+MSA F S ORC=$O(ORMSG(+ORC)) Q:ORC<1 I $E(ORMSG(ORC),1,3)="ORC" D
  1. . S X=ORMSG(ORC),ORDCNTRL=$P(X,"|",2),PKGIFN=+$P(X,"|",4)
  1. . I '$G(ORIFN) S ORIFN=+$P(X,"|",3) I ORDCNTRL["U" D ;find action to cancel
  1. .. N DA,CODE S CODE=$S(ORDCNTRL="UC":"DC",1:"NW")
  1. .. S DA=$O(^OR(100,DA,8,"C",CODE,"?"),-1) S:DA<1 DA=1
  1. .. S ORIFN=ORIFN_";"_DA
  1. . D @ORDCNTRL
  1. Q
  1. ;
  1. ERR ; -- Log an error
  1. N X S X=$P(ORERR,U,2)
  1. D EN^ORERR(X,.ORMSG)
  1. Q
  1. ;
  1. STATUS(X) ; -- Returns Order Status for HL7 code X
  1. N Y S Y=$S(X="DC":1,X="OC":1,X="CM":2,X="IP":5,X="SC":6,X="ZE":7,X="CA":7,1:"") ;phase out ZE,OC
  1. Q Y
  1. ;
  1. OK ; -- Order accepted, VBECS order # assigned [reply]
  1. S ^OR(100,+ORIFN,4)=PKGIFN ;VBECS identifier
  1. D STATUS^ORCSAVE2(+ORIFN,5) ;pending
  1. Q
  1. ;
  1. SC ; -- Status changed
  1. N ORSTS S ORSTS=$$STATUS(ORDSTS)
  1. I ORSTS=1 D OC Q ;Cancel
  1. D STATUS^ORCSAVE2(+ORIFN,ORSTS)
  1. D:ORSTS=6 DATES^ORCSAVE2(+ORIFN,ORLOG) ;Start Time
  1. I ORSTS=7 D
  1. . D DATES^ORCSAVE2(+ORIFN,,+$E($$NOW^XLFDT,1,12)) ;Stop Time
  1. . D OC ;Cancel Children
  1. Q
  1. ;
  1. OC ; -- Cancelled
  1. G:ORTYPE["ORG" UA ;reject reply
  1. S:ORNATR="" ORNATR=+$O(^ORD(100.02,"C","X",0)) ;Rejected
  1. S ^OR(100,+ORIFN,6)=ORNATR_U_ORDUZ_U_ORLOG_U_U_$E($P(OREASON,U,2),1,80)
  1. D UPDATE(1,"DC"),LAB D ;set parent's 6-node
  1. . N DAD S DAD=+$P($G(^OR(100,+ORIFN,3)),U,9)
  1. . I DAD,$P($G(^OR(100,DAD,3)),U,3)=1,'$D(^(6)) S ^OR(100,DAD,6)=^OR(100,+ORIFN,6)
  1. Q
  1. ;
  1. CR ; -- Cancelled [reply]
  1. D STATUS^ORCSAVE2(+ORIFN,1)
  1. Q
  1. ;
  1. UA ; -- Unable to accept [reply]
  1. S:'ORNATR ORNATR=$O(^ORD(100.02,"C","X",0)) ;rejected
  1. S ^OR(100,+ORIFN,6)=ORNATR_U_U_ORLOG_U_U_$E($P(OREASON,U,2),1,80)
  1. D STATUS^ORCSAVE2(+ORIFN,13),CANCEL ;cancel associated orders
  1. UC ; -- Unable to cancel [reply]
  1. DE ; -- Data Error [reply]
  1. N DA S DA=$P(ORIFN,";",2) Q:'DA
  1. S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected
  1. S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,DA,1)=$E($P(OREASON,U,2),1,240)
  1. Q
  1. ;
  1. CANCEL ; -- cancel associated lab, parent orders
  1. N ORDAD
  1. S ORDAD=+$P($G(^OR(100,+ORIFN,3)),U,9) Q:'ORDAD
  1. D CANCEL^ORCSEND2(ORDAD,$P(OREASON,U,2)) ;cancel parent+children
  1. Q
  1. ;
  1. UPDATE(ORSTS,ORACT) ; -- continue processing
  1. N DA,ORX,ORCMMT,ORP
  1. ;D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) ;DC stop set in $$STATUS
  1. D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS)
  1. S ORCMMT=$E($P(OREASON,U,2),1,240),ORX=$$CREATE^ORX1(ORNATR) D:ORX
  1. . S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,ORCMMT,ORLOG,ORDUZ)
  1. . I DA'>0 S ORERR="1^Cannot create new order action" Q
  1. . D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR)
  1. . D SIGSTS^ORCSAVE2(+ORIFN,DA)
  1. . I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
  1. . S $P(^OR(100,+ORIFN,3),U,7)=DA
  1. I '$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0
  1. D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) ;cancel unreleased actions
  1. Q
  1. ;
  1. ZP ; -- Purged
  1. Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0))
  1. S $P(^OR(100,+ORIFN,4),";",1,3)=";;" I "^5^6^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,$S($P(^(4),";",5):2,1:14)) ; Remove pkg reference, sts=lapsed if still active
  1. Q
  1. ;
  1. ZR ; -- Purged as requested [reply]
  1. D DELETE^ORCSAVE2(+ORIFN)
  1. Q
  1. ;
  1. ZU ; -- Unable to purge [reply]
  1. S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity
  1. Q
  1. ;
  1. LAB ; -- find and cancel ORIFN'S associated Lab order
  1. N ORLRIFN,ORSAVDUZ
  1. S ORLRIFN=$$VALUE^ORX8(ORIFN,"LAB")
  1. I 'ORLRIFN D ;search children for match
  1. . N ORDAD,ORIT,ORLAB,ORI,ORX
  1. . S ORDAD=+$P($G(^OR(100,+ORIFN,3)),U,9) Q:'ORDAD
  1. . S ORIT=$$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E") Q:'$L(ORIT)
  1. . S ORLAB=$$PKG^ORMPS1("LR"),(ORLRIFN,ORI)=0
  1. . F S ORI=+$O(^OR(100,ORDAD,2,+ORI)) Q:'ORI I ORI'=+ORIFN D Q:ORLRIFN
  1. .. Q:$P($G(^OR(100,ORI,0)),U,14)'=ORLAB
  1. .. S ORX=$$VALUE^ORX8(ORI,"ORDERABLE",1,"E")
  1. .. I ORX[ORIT S ORLRIFN=ORI Q
  1. I ORLRIFN D
  1. . ;reset DUZ to the person who canceled the order,
  1. . ;not the person who started the VBECS-OERR link
  1. . S ORSAVDUZ=DUZ
  1. . S DUZ=$S($G(ORDUZ):ORDUZ,1:DUZ)
  1. . D MSG^ORMBLD(ORLRIFN,"CA")
  1. . S DUZ=ORSAVDUZ
  1. . ;checking to make sure the cancel did result in a
  1. . ;discontinued status on the companion order
  1. . I $P($G(^OR(100,ORLRIFN,3)),U,3)=1,'$D(^(6)) D
  1. . . S ^OR(100,ORLRIFN,6)=$G(^OR(100,+ORIFN,6))
  1. Q