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

ORCSEND3.m

Go to the documentation of this file. 
  1. ORCSEND3 ;SLC/MKB,AGP-Release cont ;Aug 19, 2020@11:27:06
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,282,280,409,405**;Dec 17, 1997;Build 211
  1.  ;
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;Reference to PSJORPOE supported by IA #3167
  1.  ;
  1. CHILD(STRT) ; Create child order, send to package
  1.  N ORAPPT,ORPTS,A
  1.  K ORIFN D EN^ORCSAVE Q:'$G(ORIFN)  D STARTDT^ORCSAVE2(ORIFN)
  1.  I $G(STRT) D DATES^ORCSAVE2(ORIFN,STRT)
  1.  S ORCHLD=+$G(ORCHLD)+1,^OR(100,ORPARENT,2,ORIFN,0)=ORIFN,ORLAST=ORIFN
  1.  S A=$G(^OR(100,ORPARENT,0)),ORAPPT=$P(A,U,18),ORPTS=$P(A,"^",13)
  1.  S $P(^OR(100,ORIFN,0),U,18)=ORAPPT,$P(^(3),U,9)=ORPARENT
  1.  I $P(^OR(100,ORIFN,0),U,13)="" S $P(^(0),"^",13)=ORPTS ; 409 - Preserve Treating Specialty
  1.  N X0 S X0=$G(^OR(100,ORPARENT,8,1,0))
  1.  I $P(X0,U,4)'=2 D SIGN^ORCSAVE2(ORIFN,+$P(X0,U,5),ORNOW,$P(X0,U,4),1)
  1.  D COPY^OROCAPI1(ORPARENT,ORIFN)
  1.  I $G(ORENEW) S OLD=$O(ORENEW(0)) I OLD S $P(^OR(100,OLD,3),U,6)=ORIFN,$P(^OR(100,ORIFN,3),U,5)=OLD,$P(^(3),U,11)=2 K ORENEW(OLD)
  1.  D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)),NEW^ORMBLD(ORIFN)
  1.  Q
  1.  ;
  1. DOSES(IFN) ;
  1.  N I,CNT S CNT=0
  1.  S I=+$O(^OR(100,+$G(IFN),4.5,"ID","NOW",0)) I I,$G(^OR(100,+$G(IFN),4.5,I,1)) S CNT=CNT+1
  1.  Q CNT
  1.  ;
  1. GETORDER(IFN) ; Set ORX(Inst,Ptr)=Value
  1.  N I,X,Y,PTR,INST,TYPE,SOLCNT,ADDCNT
  1.  S (SOLCNT,ADDCNT)=0
  1.  S I=0 F  S I=$O(^OR(100,IFN,4.5,I)) Q:I'>0  S X=$G(^(I,0)),Y=$G(^(1)) D
  1.  . S PTR=+$P(X,U,2),INST=+$P(X,U,3),TYPE=$P($G(^ORD(101.41,PTR,1)),U)
  1.  . I TYPE'="W" S ORX(PTR,INST)=Y Q
  1.  . ;S ORX(INST,PTR)="^OR(100,"_IFN_",4.5,"_I_",2)"
  1.  . S ORX(PTR,INST)="^OR(100,"_IFN_",4.5,"_I_",2)"
  1.  Q
  1. PSJI ;
  1.  ;IV dialog
  1.  N ORPARENT,OR0,ORNP,ORDIALOG,ORDUZ,ORLOG,ORL,ORDG,ORCAT,ORX,ORP,ORI,STS
  1.  N ORDOSE,ORT,ORSCH,ORDUR,ORSTRT,ORFRST,ORCONJ,ORID,ORDD,ORSTR,ORDGNM
  1.  N ORSTART,ORCHLD,ORLAST,ORSIG,OROI,ID,OR3,ORIG,CODE,PKG,ORENEW,I,ORADMIN
  1.  N ORDUR
  1.  N CNT
  1.  S ORPARENT=+ORIFN,OR0=$G(^OR(100,ORPARENT,0)),OR3=$G(^OR(100,ORPARENT,3))
  1.  S ORCAT="I",ORNP=+$P(OR0,U,4)
  1.  ;Q:$P(OR0,U,12)'="I"  S ORCAT="I",ORNP=+$P(OR0,U,4)
  1.  S ORDIALOG=+$P(OR0,U,5),ORDUZ=+$P(OR0,U,6),ORLOG=$P(OR0,U,7)
  1.  S ORL=$P(OR0,U,10),ORDG=+$P(OR0,U,11),PKG=$$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)
  1.  ;Build ORDIALOG Array and ORX local array
  1.  D GETDLG1^ORCD(ORDIALOG),GETORDER(ORPARENT)
  1.  ;
  1.  S ORSCH=$$PTR("SCHEDULE"),ORDUR=$$PTR("DURATION")
  1.  D STRT S ORSTART=$G(ORSTRT("BEG"))
  1.  S ORADMIN=$$PTR("ADMIN TIMES")
  1.  D DATES^ORCSAVE2(ORPARENT,ORSTART) Q:$$DOSES(ORPARENT)<1
  1.  S ORFRST=$$PTR("NOW"),ORSIG=$$PTR("SIG")
  1.  ;
  1.  I $P(OR3,U,11)=2,$O(^OR(100,+$P(OR3,U,5),2,0)) D
  1.  . S ORENEW=+$P(OR3,U,5),I=0
  1.  . I $$VALUE^ORX8(ORENEW,"NOW") S I=$O(^OR(100,ORENEW,2,0))
  1.  . F  S I=$O(^OR(100,ORENEW,2,I)) Q:I<1  S ORENEW(I)=""
  1.  ;
  1. PSJI1 ;
  1.  ;Build Order Dialog Prompts that can have Multiple Responses
  1.  F ORP="ADDITIVE","ORDERABLE ITEM","STRENGTH PSIV","UNITS","VOLUME" D
  1.  . N PTR S PTR=$$PTR(ORP) Q:PTR'>0  Q:'$D(ORX(PTR,1))
  1.  . S CNT=0 F  S CNT=$O(ORX(PTR,CNT)) Q:CNT'>0  S ORDIALOG(PTR,CNT)=ORX(PTR,CNT)
  1.  ;
  1.  ;Build Order Dialog Responses that should be in both Child Orders
  1.  F ORP="INFUSION RATE","IV TYPE","ROUTE","URGENCY","WORD PROCESSING 1","INDICATION" D   ;*405-IND
  1.  . N PTR S PTR=$$PTR(ORP) Q:PTR'>0  Q:'$D(ORX(PTR,1))
  1.  . S ORDIALOG(PTR,1)=ORX(PTR,1) S:$E(ORP)="O" OROI=ORX(PTR,1) Q
  1.  ;
  1.  ;If NOW order create NOW Child Order
  1.  I $G(ORX(ORFRST,1)) D
  1.  . S:$D(ORX(ORP,1)) ORDIALOG(ORP,1)=ORX(ORP,1)
  1.  . ;S ID=$G(ORX(ORI,ORID)) S:$P(ID,"&",6) ORDIALOG(ORDD,1)=$P(ID,"&",6)
  1.  . S ORDIALOG(ORSCH,1)="NOW",ORSTART=$$NOW^XLFDT
  1.  . D CHILD(ORSTART)
  1.  ;
  1.  ;Build Order Fields for non-NOW Child Order
  1.  F ORP=ORSCH,ORADMIN,ORDUR S:$D(ORX(ORP,1)) ORDIALOG(ORP,1)=ORX(ORP,1) K:'$D(ORX(ORP,1)) ORDIALOG(ORP,1)
  1.  S ORSTART=$G(ORSTRT(1))
  1.  D CHILD(ORSTART)
  1.  ;
  1.  S:$G(ORCHLD) ^OR(100,ORPARENT,2,0)="^100.002PA^"_ORLAST_U_ORCHLD
  1.  S ORIFN=ORPARENT,ORQUIT=1,OR3=$G(^OR(100,ORIFN,3)),STS=$P(OR3,U,3)
  1.  I (STS=1)!(STS=13)!(STS=11) S ORERR="1^Unable to release orders"
  1.  D RELEASE^ORCSAVE2(ORIFN,1,ORNOW,DUZ,$G(NATURE)) K ^TMP("ORWORD",$J)
  1.  S $P(^OR(100,ORIFN,3),U,8)=1 ;veil parent order - set stop date/time?
  1.  Q:(STS=1)!(STS=13)!(STS=11)  ;unsuccessful
  1. PSJI2 ; ck if parent is unsigned or edit
  1.  I $P($G(^OR(100,ORIFN,8,1,0)),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;clear ES
  1.  Q:$P(OR3,U,11)'=1  S ORIG=$P(OR3,U,5) Q:ORIG'>0
  1.  S CODE=$S($P($G(^OR(100,ORIG,3)),U,3)=5:"CA",1:"DC")
  1.  D MSG^ORMBLD(ORIG,CODE) I "^1^13^"[(U_$P($G(^OR(100,ORIG,3)),U,3)_U) D
  1.  . N NATR S NATR=+$O(^ORD(100.02,"C","C",0))
  1.  . S $P(^OR(100,ORIG,3),U,3)=12,$P(^(3),U,7)=0,^(6)=NATR_U_DUZ_U_ORNOW
  1.  . D CANCEL^ORCSEND(ORIG) ;ck for unrel actions
  1.  Q
  1. PTR(X) ; Returns ptr of prompt X in Order Dialog file
  1.  Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
  1.  ;
  1. STRT ; Build ORSTRT(inst)=date.time array of start times by dose
  1.  N OI,PSOI,XD,XH,XM,XS,ORWD,ORI,SCH,ORSD,X,ORD K ORSTRT
  1.  S OI=$G(ORX($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1))
  1.  ;if OI is null assume Intermittent IV order this does not required a
  1.  ;solution check for an additive only value
  1.  I OI="" S OI=$G(ORX($$PTR^ORCD("OR GTX ADDITIVE"),1))
  1.  S PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2),(XD,XH,XM,XS)=0
  1.  S ORWD=+$G(^SC(+$G(ORL),42)) ;ward
  1.  ;S ORI=0 F  S ORI=$O(ORX(ORI)) Q:ORI<1  D
  1.  S SCH=$G(ORX(ORSCH,1)),ORSD="" S:'$L(SCH) X=$$NOW^XLFDT
  1.  S:$L(SCH) ORSD=$$STARTSTP^PSJORPOE(+ORVP,SCH,PSOI,ORWD),X=$P(ORSD,U,4)
  1.  S ORSTRT(1)=$$FMADD^XLFDT(X,XD,XH,XM,XS) ;START+OFFSET
  1.  ; find beginning date.time for parent
  1.  S ORI=0,X=9999999 F  S ORI=$O(ORSTRT(ORI)) Q:ORI<1  I ORSTRT(ORI)<X S X=ORSTRT(ORI)
  1.  S ORSTRT("BEG")=X
  1.  Q