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

ORWDXM2.m

Go to the documentation of this file.
  1. ORWDXM2 ; SLC/KCM - Quick Orders ; 11/1/11 11:30am
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,116,132,158,187,195,215,243,280,356,377**;Dec 17, 1997;Build 582
  1. ;
  1. ADMTIME(ORDLOC,PATLOC,ENCLOC,DELAY,ISIMO) ;
  1. N ADMLOC,INST,SCHLOC,SCHTYPE
  1. S ADMLOC=+$P($G(ORDIALOG("B","ADMINISTRATION TIMES")),U,2)
  1. I ADMLOC>0,ORDLOC>0,PATLOC'=ORDLOC D Q
  1. .S INST=0 F S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0 D
  1. ..S ORDIALOG(ADMLOC,INST)=""
  1. I ADMLOC>0,$S(ENCLOC'=PATLOC:1,ISIMO:1,DELAY:1,1:0) D Q
  1. .S INST=0 F S INST=$O(ORDIALOG(ADMLOC,INST)) Q:+INST'>0 D
  1. ..S ORDIALOG(ADMLOC,INST)=""
  1. S SCHLOC=+$P($G(ORDIALOG("B","SCHEDULE TYPE")),U,2) Q:SCHLOC'>0
  1. S INST=0 F S INST=$O(ORDIALOG(SCHLOC,INST)) Q:+INST'>0 D
  1. .S SCHTYP=$G(ORDIALOG(SCHLOC,INST)) Q:SCHTYP=""
  1. .I $S(SCHTYP="P":1,SCHTYP="O":1,SCHTYP="OC":1,1:0),ADMLOC>0 S ORDIALOG(ADMLOC,INST)=""
  1. Q
  1. ;
  1. CLRRCL(OK) ; clear ORECALL
  1. S OK=1
  1. K ^TMP("ORECALL",$J),^TMP("ORWDXMQ",$J)
  1. Q
  1. VERTXT ; set verify text for order
  1. N SEQ,DA,X,PROMPT,MULT,CHILD,INST,TITLE,TEMP,ILST,SPACES
  1. N ISADMIN
  1. S ILST=0,$P(SPACES," ",31)=""
  1. S SEQ=0 F S SEQ=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ)) Q:SEQ'>0 D
  1. . S DA=0 F S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,DA)) Q:'DA D
  1. . . S X0=$G(^ORD(101.41,+ORDIALOG,10,DA,0))
  1. . . S ISADMIN=$S(+OREVENT>0:0,ISIMO=1:0,$P($G(^ORD(101.41,$P(X0,U,2),0)),U)="OR GTX ADMIN TIMES":1,1:0)
  1. . . I ISADMIN=1,ORDLOC>0,ORDLOC'=PATLOC Q
  1. . . I $P(X0,U,9)["*",ISADMIN=0 Q
  1. . . S PROMPT=$P(X0,U,2),MULT=$P(X0,U,7),CHILD=$P(X0,U,11) I CHILD,ISADMIN=0 Q
  1. . . Q:'PROMPT S INST=$O(ORDIALOG(PROMPT,0)) Q:'INST ; no values
  1. . . S TITLE=$S($L($G(ORDIALOG(PROMPT,"TTL"))):ORDIALOG(PROMPT,"TTL"),1:ORDIALOG(PROMPT,"A"))
  1. . . I $E(ORDIALOG(PROMPT,0))="W" D
  1. . . . N IWP,WP,CNT
  1. . . . S IWP=0,CNT=0
  1. . . . F S IWP=$O(^TMP("ORWORD",$J,PROMPT,INST,IWP)) Q:'IWP D
  1. . . . . S CNT=CNT+1,WP(CNT)=^TMP("ORWORD",$J,PROMPT,INST,IWP,0)
  1. . . . I CNT=1 S ILST=ILST+1,LST(ILST)=$J(TITLE,30)_WP(1)
  1. . . . I CNT>1 D
  1. . . . . S ILST=ILST+1,LST(ILST)=TITLE,IWP=0
  1. . . . . F S IWP=$O(WP(IWP)) Q:'IWP S ILST=ILST+1,LST(ILST)=WP(IWP)
  1. . . E D
  1. . . . S TEMP=$$ITEM^ORCDLG(PROMPT,INST) I TEMP="" Q
  1. . . . S ILST=ILST+1,LST(ILST)=$J(TITLE,30)
  1. . . . ;S LST(ILST)=LST(ILST)_$$ITEM^ORCDLG(PROMPT,INST)
  1. . . . S LST(ILST)=LST(ILST)_TEMP
  1. . . Q:'MULT Q:'$O(ORDIALOG(PROMPT,INST)) ; done
  1. . . F S INST=$O(ORDIALOG(PROMPT,INST)) Q:INST'>0 S ILST=ILST+1,LST(ILST)=SPACES_$$ITEM^ORCDLG(PROMPT,INST)
  1. ;*356 Only display SC and TF for orders that are not new.
  1. I $G(ORWMODE) D DISPLAY^ORWDBA3 ;for display of Billing Aware data from orig order
  1. Q
  1. RA ; setup environment for radiology
  1. ; -- get imaging types based on display group of quick order and
  1. ; setup list of imaging locations based on imaging type
  1. N ISPREG,ORY,ITYPE,IFN,CNT,ORIMLOC,PROMPT
  1. S ORDIV=$$DIV^ORCDRA1,ITYPE=$P($G(^ORD(100.98,+ORDG,0)),U,3)
  1. S ORIMTYPE=$O(^RA(79.2,"C",ITYPE,0))
  1. D EN4^RAO7PC1(ITYPE,"ORY")
  1. S (IFN,CNT)=0 F S IFN=$O(ORY(IFN)) Q:IFN'>0 D
  1. . S CNT=CNT+1,ORIMLOC(CNT)=ORY(IFN),ORIMLOC("B",$P(ORY(IFN),U,2))=IFN
  1. I '$$GET^XPAR("ALL","RA SUBMIT PROMPT",1,"Q"),CNT>1 K ORIMLOC
  1. E S ORIMLOC=CNT_"^1"
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX IMAGING LOCATION",0))
  1. I $G(ORIMLOC) M ORDIALOG(PROMPT,"LIST")=ORIMLOC
  1. Q
  1. LR ; setup environment for lab
  1. ; -- setup ORTIME, ORIMTIME & ORTEST arrays
  1. ; setup ORMAX, ORDG, & ORCOLLCT variables
  1. N PROMPT,INST,EDITONLY
  1. D GETIMES^ORCDLR1 ; sets up ORTIME and ORIMTIME arrays
  1. S ORMAX=$$GET^XPAR("ALL^LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q")
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),INST=1
  1. D LRTEST ; sets up ORTEST array and ORDG
  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
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ADMIN SCHEDULE",0))
  1. I $D(ORDIALOG(PROMPT,1)) S ORSCH=ORDIALOG(PROMPT,1)
  1. Q
  1. LRTEST ; -- Setup ORTEST() array of ordering parameters (copied from ORCDLR)
  1. N OI,TST,DG
  1. S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI
  1. I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
  1. S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB"
  1. S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG
  1. Q
  1. LRRQCM() ; return true if lab test has required comments
  1. I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 1 ; edit via WP
  1. N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM,OI,TST
  1. S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN")
  1. S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI 0
  1. I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
  1. S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0))
  1. S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6)
  1. S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19)
  1. Q REQDCOMM
  1. LRASMP() ; return true to ask collection sample (from ASKSAMP^ORCDLR)
  1. N DEFSAMP,SAMP0
  1. S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0))
  1. I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) Q 0
  1. I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask
  1. I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask
  1. I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice
  1. Q 1
  1. LRICTMOK ;
  1. Q:'$D(ORDIALOG(PROMPT,1))
  1. N ORY
  1. D VALDT^ORWU(.ORY,ORDIALOG(PROMPT,1))
  1. I +$$VALID^LR7OV4(DUZ(2),ORY)=0 S ORDIALOG(PROMPT,1)=""
  1. Q
  1. DO ; setup environment for diet order
  1. ; partially copied from EN^ORCDFH
  1. I ORCAT'="I" D Q
  1. . S ORQUIT=1
  1. . S LST(0)="8^0"
  1. . S LST(.5)="This type of diet may be entered for inpatients only."
  1. D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters
  1. S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
  1. N PROMPT,OI ; set NPO flag if NPO diet
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. S OI=+$G(ORDIALOG(PROMPT,1))
  1. S ORNPO=($P($G(^ORD(101.43,OI,0)),U)="NPO")
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))
  1. S X=$G(ORDIALOG(PROMPT,1)) I $L(X) D CNV^ORCDFH1 S ORDIALOG(PROMPT,1)=$G(X)
  1. ;AGP TEST FOR ACTIVE TUBEFEEDING ORDERS
  1. I $$CURRENT^ORCDFH("TF")>0 S AUTOACK=0
  1. Q
  1. EL ; setup environment for early/late tray
  1. D EN^FHWOR8(+ORVP,.ORPARAM) ; set FH ordering parameters
  1. S:'$L($G(ORPARAM(3))) ORPARAM(3)="T" ; for now
  1. D EN2^ORCDFH ; setup ORTIME array
  1. N PROMPT ; set ORMEAL,ORTRAY
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX MEAL",0))
  1. I $D(ORDIALOG(PROMPT,1)) S ORMEAL=ORDIALOG(PROMPT,1)
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. I $D(ORDIALOG(PROMPT,1)) S ORTRAY=ORDIALOG(PROMPT,1)
  1. ;AGP TEST FOR ACTIVE TUBEFEEDING ORDERS
  1. I $$CURRENT^ORCDFH("TF")>0 S AUTOACK=0
  1. Q
  1. UD ; setup environment for unit dose med
  1. I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed
  1. ;
  1. D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds
  1. N PROMPT,OI
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. I $D(ORDIALOG(PROMPT,1)) S OI=ORDIALOG(PROMPT,1) D MEDACTV(1) Q:$G(ORQUIT)
  1. D INSTR^ORCDPS(OI) ; sets up instructions, routes, etc.
  1. D CHOICES^ORCDPS("U") ; gets list of dispense drugs
  1. Q
  1. IV ; setup environment for IV fluid
  1. D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds
  1. ; sets up list of volumes if only one solution
  1. ; otherwise, let the dialog go interactive
  1. N PROMPT,INST,CNT,OI
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0))
  1. S (CNT,INST)=0
  1. F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT)
  1. . S CNT=CNT+1
  1. . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(3) ; check active solutions
  1. I CNT=1 S INST=1 D VOLUME^ORCDPSIV
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ADDITIVE",0))
  1. S INST=0
  1. F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST D Q:$G(ORQUIT)
  1. . S OI=ORDIALOG(PROMPT,INST) D MEDACTV(4) ; check active additives
  1. Q
  1. OP ; setup environment for outpatient pharmacy
  1. I $G(ORWP94) G PS^ORWDPS3 ; if patch 94 installed
  1. ;
  1. D AUTHMED Q:$G(ORQUIT) ; checks authorized to write meds
  1. N PROMPT,INST,CNT,OI
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX ORDERABLE ITEM",0)),OI=0
  1. I $D(ORDIALOG(PROMPT,1)) S OI=$G(ORDIALOG(PROMPT,1)) D MEDACTV(2) Q:$G(ORQUIT)
  1. D:+OI INSTR^ORCDPS(OI) ; sets up instructions, routes, etc.
  1. D CHOICES^ORCDPS("O") ; gets list of dispense drugs
  1. ; get defaults for drug, refills if only one dispense drug
  1. S PROMPT=$O(^ORD(101.41,"B","OR GTX DISPENSE DRUG",0))
  1. S (CNT,INST)=0
  1. F S INST=$O(ORDIALOG(PROMPT,INST)) Q:'INST S CNT=CNT+1
  1. I CNT=1 D
  1. . S ORDRUG=+$G(ORDIALOG(PROMPT,1)),ORCOMPLX=0
  1. . S OREFILLS=$P($G(ORDIALOG(PROMPT,"LIST","D",ORDRUG)),U,3)
  1. . S:'$L(OREFILLS) OREFILLS=11
  1. E S ORCOMPLX=1,OREFILLS=11 ; force interactive on complex order
  1. S ORCOPAY=1 ; ask SC if can't determine copay
  1. I $G(ORDRUG),$L($T(ASKSC^ORCDPS)) S ORCOPAY=$$ASKSC^ORCDPS
  1. Q
  1. AUTHMED ; sets ORQUIT if not authorized to write meds
  1. N NOAUTH,NAME
  1. D AUTH^ORWDPS32(.NOAUTH,ORNP)
  1. I +NOAUTH D
  1. . S ORQUIT=1
  1. . S LST(0)="8^0"
  1. . ; FIX FOR REMEDY 71069, CQ 15917
  1. . S LST(.5)=$P(NOAUTH,U,2)
  1. . ;S NAME=$P($G(^VA(200,+ORNP,20)),U,2)
  1. . ;I '$L(NAME) S NAME=$P($G(^VA(200,+ORNP,0)),U,1)
  1. . ;S LST(.5)=NAME_" is not authorized to write med orders."
  1. Q
  1. MEDACTV(USAGE) ; sets ORQUIT if the orderable item is not active for a med
  1. Q:'$G(OI) S USAGE=+$G(USAGE)
  1. I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D Q
  1. . S ORQUIT=1,LST(0)="8^0"
  1. . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore."
  1. I USAGE,'$P($G(^ORD(101.43,OI,"PS")),U,USAGE) D Q
  1. . S ORQUIT=1,LST(0)="8^0"
  1. . S LST(.5)=$P($G(^ORD(101.43,OI,0)),U)_" may not be ordered as an "_$S(USAGE=1:"inpatient medication",USAGE=2:"outpatient medication",USAGE=3:"IV solution",1:"IV additive")_" anymore."
  1. Q
  1. SCHEDULD() ; Is patient scheduled for PREOP (Imaging)
  1. I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date
  1. E Q 0
  1. Q