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;05/09/17 ;Jun 21, 2022@14:26:46
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,215,296,280,394,350,434,569**;Dec 17, 1997;Build 23
  1. ;
  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. ; 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. ;p394 force interactive dialog for imaging QO for female of child-bearing age.
  1. N ORRAORD S ORRAORD=0 ;set is radiology flag to false (0)
  1. I ORDIALOG=$O(^ORD(101.41,"B","RA OERR EXAM",0)) D
  1. . N ORPRMPT1,ORPRMPT2,ORCODE S ORRAORD=1
  1. . Q:($G(ORTYPE)'="Q")!($G(ORSEX)'="F")
  1. . S ORPRMPT1=$O(^ORD(101.41,"B","OR GTX PREGNANT",0)),ORPRMPT2=$P($G(ORDIALOG(ORPRMPT1)),"^")
  1. . S ORCODE=$G(^ORD(101.41,ORDIALOG,10,ORPRMPT2,7)) N Y S Y="Y" X ORCODE K ORCODE
  1. . S:Y="Y" ORWPSWRG="" ;
  1. I ORRAORD 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","LR OTHER LAB AP 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","PSJ OR CLINIC 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","CLINIC 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","SD RTC",0)) D RTC^ORWDSD1 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
  1. S OCAT=$P($G(^OR(100,+IFN,0)),U,12)
  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,PROMPT,I,X,X0
  1. 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. I '$D(ORTEST("Lab CollSamp")) D
  1. . N I,V,T,LC S LC=1
  1. . F I=1:1:$L(ORTEST,U) S V=+$P(ORTEST,U,I) D Q:'LC ;no LC samp
  1. .. S T=$$LAB60^ORCDVBEC(V) ;VBECS ID -> #60 ien
  1. .. I '$P($G(^LAB(60,T,0)),U,9) S LC=0 Q
  1. . S ORTEST("Lab CollSamp")=LC
  1. I '$D(ORTIME),'$D(ORIMTIME) D GETIMES^ORCDLR1
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))
  1. I $D(ORDIALOG(PROMPT,1)) S ORCOLLCT=ORDIALOG(PROMPT,1) I 1
  1. E S EDITONLY=0,ORCOLLCT=$$COLLTYPE^ORCDLR1
  1. I ORCOLLCT="I" D
  1. . S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
  1. . D LRICTMOK^ORWDXM2
  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