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

ORWDXM4.m

Go to the documentation of this file. 
  1. ORWDXM4 ; SLC/KCM - Order Dialogs, Menus;01-Apr-2013 16:20;PLS
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,215,296,1010**;Dec 17, 1997;Build 47
  1.  ; Modified - IHS/MSC/MGH - 06/04/12 - Line CHGSTS+3
  1.  ;            IHS/MSC/PLS - 04/01/13 - Line SETUP+2
  1. SETUP ; -- setup dialog (continued from ORWDXM1)
  1.  ;    if xfer med order, setup ORDIALOG differently
  1.  ;I ORWMODE,$$ISMED(ORIT),$$CHGSTS(ORCAT,ORIT) D MEDXFER Q
  1.  I ORWMODE,ORWMODE'=3,$$ISMED(ORIT),$$CHGSTS(ORCAT,ORIT) D MEDXFER Q
  1.  ;    get base dialog (based on display group) & location of responses
  1.  I ORWMODE D
  1.  . S ORDG=$P(^OR(100,+ORIT,0),U,11),ORDIALOG=+$P(^(0),U,5)
  1.  . S RSPREF="^OR(100,"_+ORIT_",4.5)"
  1.  E  D
  1.  . N X0 S X0=$G(^ORD(101.41,ORIT,0))
  1.  . S ORDIALOG=$S($P(X0,U,4)="D":ORIT,1:0)
  1.  . S ORDG=$P(X0,U,5) Q:'ORDG
  1.  . I 'ORDIALOG S ORDIALOG=+$$DEFDLG^ORWDXQ(ORDG)
  1.  . S RSPREF="^ORD(101.41,"_ORIT_",6)"
  1.  ;    setup the ORDIALOG array
  1.  D GETDLG^ORCD(ORDIALOG)
  1.  D GETORDER^ORCD(RSPREF)
  1.  Q
  1. SETUPS ; -- setup for specific types of dialogs (continued from ORWDXM1)
  1.  ; pharmacy uses ORCAT to know order package
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0)) S ORCAT="O"
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) D
  1.  . I ORCAT="O",'ORIMO S ORWPSWRG="" ; not auto-ack, pt not inpt
  1.  . S ORCAT="I"
  1.  I ORCAT="O",$D(OREVENT("EFFECTIVE")),(ORDG=+$O(^ORD(100.98,"B","O RX",0))) D
  1.  . S ORDIALOG($O(^ORD(101.41,"B",X,0)),1)=OREVENT("EFFECTIVE")
  1.  I ORDIALOG=$O(^ORD(101.41,"B","RA OERR EXAM",0))         D RA^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0))   D LR^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","FHW1",0))                 D DO^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","FHW2",0))                 D EL^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSJ OR PAT OE",0))        D UD^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE",0)) D IV^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSO OERR",0))             D OP^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PSO SUPPLY",0))           D OP^ORWDXM2 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","PS MEDS",0))              D PS^ORWDPS3 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0))      D VB^ORWDXM4 G XENV
  1.  I ORDIALOG=$O(^ORD(101.41,"B","GMRAOR ALLERGY ENTER/EDIT",0)) S ORQUIT=1
  1. XENV ;    end case
  1.  Q
  1. MEDXFER ; -- setup ORDIALOG for a med that is transferred (from SETUP)
  1.  ;
  1.  ; use ORWDPS3 if OR*3*94 installed
  1.  I ORWP94 G MEDXFER^ORWDPS3
  1.  ;
  1.  N UDLG,FDLG,ODLG,DLG,OI K ^TMP("PS",$J)
  1.  S UDLG=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0))
  1.  S FDLG=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
  1.  S ODLG=$O(^ORD(101.41,"AB","PSO OERR",0))
  1.  S DLG=$P($G(^OR(100,+ORIT,0)),U,5)
  1.  S ORDIALOG=$S(+DLG=UDLG:ODLG,+DLG=ODLG:UDLG,+DLG=FDLG:FDLG,1:0)
  1.  I 'ORDIALOG D SETERR(ORIT,"Incomplete Order Record") Q
  1.  S ORDG=+$P(^ORD(101.41,ORDIALOG,0),U,5)
  1.  D GETDLG^ORCD(ORDIALOG)
  1.  D GETORDER^ORCD("^OR(100,"_+ORIT_",4.5)")
  1.  S OI=$$VAL^ORCD("MEDICATION")
  1.  I '$$MEDOK(OI,ORCAT) D SETERR(ORIT,"This may not be ordered as an "_$S(ORCAT="I":"in",1:"out")_"patient drug.") Q
  1.  I $G(^ORD(101.43,OI,.1)),(^(.1)<$$NOW^XLFDT) D SETERR(ORIT,"This may no longer be ordered.") Q
  1.  K ORDIALOG($$PTR("DISPENSE DRUG"),1)
  1.  K ORDIALOG($$PTR("WORD PROCESSING 1"),1)
  1.  I ORDIALOG=ODLG D IN2OUT  ; could call  IN^ORCMED except for writes
  1.  I ORDIALOG=UDLG D OUT2IN  ; could call OUT^ORCMED except for writes
  1.  Q
  1. IN2OUT ; -- make inpatient responses into outpatient
  1.  N I,DDRUG,PKGID,DOSE
  1.  S DOSE=$G(ORDIALOG($$PTR("INSTRUCTIONS"),1))
  1.  F I="INSTRUCTIONS","UNITS/DOSE","FREE TEXT","DISPENSE DRUG" K ORDIALOG($$PTR(I),1)
  1.  S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
  1.  D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
  1.  I $P(DDRUG,U,3) S ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
  1.  ;    keep instructions if IV med, otherwise use units returned
  1.  I $P($G(^ORD(101.43,OI,"PS")),U)=2 S ORDIALOG($$PTR("INSTRUCTIONS"),1)=DOSE
  1.  E  S:$P(DDRUG,U,2) ORDIALOG($$PTR("INSTRUCTIONS"),1)=$P(DDRUG,U,2)
  1.  ;    change orderable item if new orderable item returned
  1.  I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,OI,0)),U,2) D
  1.  . S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
  1.  . S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
  1.  Q
  1. OUT2IN ; make outpatient responses into inpatient
  1.  N ORP,ORI,PROMPT,PKGID,DDRUG,ONE
  1.  D CHANGED^ORCDPS("XFR") ; Kill extra values not in inpt dialog
  1.  S PKGID=$G(^OR(100,+ORIT,4))_";"_$P(^(0),U,12)
  1.  D OEL^PSOORRL(+ORVP,PKGID) S DDRUG=$G(^TMP("PS",$J,"DD",1,0))
  1.  S:$P(DDRUG,U,3) ORDIALOG($$PTR("DISPENSE DRUG"),1)=$P(DDRUG,U,3)
  1.  I $P(DDRUG,U,4),$P(DDRUG,U,4)'=+$P($G(^ORD(101.43,+OI,0)),U,2) D
  1.  . S OI=+$O(^ORD(101.43,"ID",+$P(DDRUG,U,4)_";99PSP",0))
  1.  . S:OI ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
  1.  S ONE=$O(ORDIALOG($$PTR("INSTRUCTIONS"),0)) ; first inst
  1.  F ORP="ROUTE","SCHEDULE" D
  1.  . S ORI=0,PROMPT=$$PTR(ORP)
  1.  . F  S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI'>0  I ORDIALOG(PROMPT,ORI)=""!(ORI>ONE) K ORDIALOG(PROMPT,ORI)
  1.  Q
  1. PTR(NAME) ; -- Returns pointer to OR GTX NAME (copied from ORCMED)
  1.  Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
  1.  ;
  1. MEDOK(OI,CAT) ; return 1 if med may be ordered for this patient category
  1.  N P S P=$S(CAT="I":1,1:2)
  1.  Q $P($G(^ORD(101.43,+OI,"PS")),U,P)
  1.  ;
  1. CHGSTS(ECAT,IFN) ; return 1 if out to in or in to out
  1.  N OCAT,PKG
  1.  S OCAT=$P($G(^OR(100,+IFN,0)),U,12)
  1.  ;IHS/MSC/MGH patch 1010
  1.  S PKG=$P($G(^OR(100,+IFN,0)),U,14)
  1.  I $P($G(^DIC(9.4,PKG,0)),U,2)="PSH" S OCAT="O"
  1.  Q OCAT'=ECAT
  1.  ;
  1. ISMED(IFN) ; return 1 if this is a pharmacy order
  1.  N PKG S PKG=$P($G(^OR(100,+IFN,0)),U,14)
  1.  Q $$NMSP^ORCD(PKG)="PS"
  1. SETERR(ID,X) ; sets LST to rejection with error message
  1.  D GETTXT^ORWORR(.LST,ID)
  1.  S LST(0)="8^0",LST(.5)=X,LST(.6)=""
  1.  Q
  1. VB ; setup environment for VBECS
  1.  ; -- setup ORTIME, ORIMTIME arrays
  1.  D GETIMES^ORCDLR1
  1.  ; -- setup ORCOMP, ORTEST, and ORTAS
  1.  S (ORCOMP,ORTEST,ORTAS)=""
  1.  N P,I,X,X0 S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
  1.  S I=0 F  S I=$O(ORDIALOG(P,I)) Q:I<1  S X=+$G(ORDIALOG(P,I)) D
  1.  . S X0=$G(^ORD(101.43,X,"VB")),X=+$P($G(^(0)),U,2)
  1.  . I $P(X0,U) S ORCOMP=ORCOMP_$S($L(ORCOMP):U,1:"")_X Q
  1.  . S ORTEST=ORTEST_$S($L(ORTEST):U,1:"")_X
  1.  . I X=2 S ORTAS=1
  1.  Q
  1. VBASK(I) ; set the ORASK variable for child component prompts in VBECS order
  1.  I ORDIALOG'=$O(^ORD(101.41,"B","VBEC BLOOD BANK",0)) Q
  1.  N P S P=+$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
  1.  N OI S OI=+$G(ORDIALOG(P,I))
  1.  I +$G(^ORD(101.43,+$G(OI),"VB")) S ORASK=1
  1.  Q
  1. VBQO(IFN) ;Check to see if it's a good VBECS QO
  1.  ;regular order treated as good QO
  1.  ;
  1.  I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1
  1.  N ODP,ODG,RESULT,P,TNS,I
  1.  S RESULT=0
  1.  S ODP=+$P($G(^ORD(101.41,IFN,0)),U,7),ODG=+$P($G(^(0)),U,5)
  1.  S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3)
  1.  I ODP'["VBEC" Q 1
  1.  Q RESULT