ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;Sep 13, 2022@13:32:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243,303,296,280,350,434,441,397,377,498,405**;Dec 17, 1997;Build 211
;
;
;
VALCOUNT(NAME,ORDIALOG) ;
N COUNT,IEN,NUM
S NUM=0,COUNT=0
S IEN=$P($G(ORDIALOG("B",NAME)),U,2) Q:IEN'>0
F S NUM=$O(ORDIALOG(IEN,NUM)) Q:+NUM'>0 S COUNT=COUNT+1
Q COUNT
;
ISMISSFL(ORDIALOG,IVTYPE) ;
N ADDCNT,RESULT,SOLCNT,STRCNT
S RESULT=0
S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
S STRCNT=$$VALCOUNT("STRENGTH",.ORDIALOG)
S SOLCNT=$$VALCOUNT("SOLUTION",.ORDIALOG)
I IVTYPE'="I",ADDCNT'=STRCNT S RESULT=1
I IVTYPE="I" D
.I ADDCNT=0,SOLCNT>0 Q
.I ADDCNT=0 S RESULT=1 Q
.I ADDCNT'=STRCNT S RESULT=1 Q
Q RESULT
;
IVADFCHK(ORDIALOG) ;
; This line tag checks to see if there are the same number of values
;for ADDITIVE and Additive Frequency. This also checks to see if
;the value assigned to ADDFREQ is one of the three possible values
;All Bags, 1 bag/day, See Comments. If See Comments it also checks
;for text in the comment section.
N ADDCNT,ADDFCNT,ADDFREQ,COMMENT,FREQ,INST,RESULT
S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
S ADDFCNT=$$VALCOUNT("ADDITIVE FREQUENCY",.ORDIALOG)
I ADDCNT'=ADDFCNT Q 0
S ADDFREQ=$O(^ORD(101.41,"AB","OR GTX ADDITIVE FREQUENCY",""))
S COMMENT=$O(^ORD(101.41,"AB","OR GTX WORD PROCESSING 1",""))
I +$G(ADDFREQ)'>0 Q 0
S INST=0,RESULT=1
F S INST=$O(ORDIALOG(ADDFREQ,INST)) Q:INST'>0!(RESULT=0) D
.S FREQ=$$ADDFRQCV^ORMBLDP1($G(ORDIALOG(ADDFREQ,INST)),"O")
.I FREQ="A"!(FREQ=1) Q
.I FREQ="" S RESULT=0 Q
.I FREQ="S",'$L($G(ORDIALOG(COMMENT,1))) S RESULT=0 Q
Q RESULT
;
KEYVAR(DLG) ; Parse entry action for key variables & return in string
; RV=CollTp^Samp^Spec^CollDt^Urg^Sched^NoComm^NoDiag^NoProv^NoRsn
N XCODE,RV,POS,Z
S XCODE=$G(^ORD(101.41,DLG,3)),RV=""
I '$L(XCODE) Q ""
S POS=$F(XCODE,"LRFZX=") I POS S $P(RV,U,1)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"LRFSAMP=") I POS S $P(RV,U,2)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"LRFSPEC=") I POS S $P(RV,U,3)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"LRFDATE=") I POS S $P(RV,U,4)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"LRFURG=") I POS S $P(RV,U,5)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"LRFSCH=") I POS S $P(RV,U,6)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"PSJNOPC=") I POS S $P(RV,U,7)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"GMRCNOPD=") I POS S $P(RV,U,8)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"GMRCNOAT=") I POS S $P(RV,U,9)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"GMRCREAF=") I POS S $P(RV,U,10)=$$VALUE(XCODE,POS)
S POS=$F(XCODE,"ORFORGET=") I POS D
. ; need to change this so that it is executed in SETKEYV so
. ; that it is executed each time menu is revisited
. N ORFORGET S ORFORGET=$$VALUE(XCODE,POS)
. I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET)
. E K ^TMP("ORECALL",$J)
Q RV
VALUE(STR,BEG) ; Return value of "var=" (copied from ORCONVRT)
N X,Y,I S X=$E(STR,BEG,999),Y=""
S:$E(X)="""" X=$E(X,2,999) ; strip leading "
F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z
Q $TR(Y,U,"")
;
SETKEYV(X) ; Set the key variables based on contents of X
I $L($P(X,U,1)) S LRFZX=$P(X,U,1)
I $L($P(X,U,2)) S LRFSAMP=$P(X,U,2)
I $L($P(X,U,3)) S LRFSPEC=$P(X,U,3)
I $L($P(X,U,4)) S LRFDATE=$P(X,U,4)
I $L($P(X,U,5)) S LRFURG=$P(X,U,5)
I $L($P(X,U,6)) S LRFSCH=$P(X,U,6)
I $L($P(X,U,7)) S PSJNOPC=$P(X,U,7)
I $L($P(X,U,8)) S GMRCNOPD=$P(X,U,8)
I $L($P(X,U,9)) S GMRCNOAT=$P(X,U,9)
I $L($P(X,U,10)) S GMRCREAF=$P(X,U,10)
Q
DLGINFO(IEN,MODE) ; return information about a dialog
; IEN=DlgIEN or ORIFN, MODE=0:Dlg,1:Copy,2:Change
; RESULT=DlgIEN^DlgType^FormID^DGrp
; If MODE="1;T",don't check "PS MEDS" for transfer order
; PSMDGP=1: Unit/Dose Group
; PSMDGP=2: OutPatient Group
N X0,DLGIEN,TYP,FID,DGRP,PSMDGP,ISXF
S PSMDGP=0,ISXF=""
S ISXF=$P(MODE,";",2)
S MODE=+MODE
S DLGIEN=IEN I MODE,(ISXF'="T") D
. S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5)
. I $P(^ORD(101.41,DLGIEN,0),U)="PS MEDS" D
. . N PTCAT S PTCAT=$P($G(^OR(100,+IEN,0)),U,12)
. . I PTCAT="I" S DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)),PSMDGP=1
. . I PTCAT="O" S DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)),PSMDGP=2
I MODE,(ISXF="T") S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5)
S X0=$G(^ORD(101.41,DLGIEN,0)),TYP=$P(X0,U,4),DGRP=$P(X0,U,5)
I MODE S DGRP=+$P($G(^OR(100,+IEN,0)),U,11)
;JD NEW START 11/13/02
I DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) S PSMDGP=1
I DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)) S PSMDGP=2
;JD NEW END 11/13/02
; for copy or change, if the base dialog has changed, use it's info
I MODE,$G(ORDIALOG),(+DLGIEN'=+ORDIALOG),(PSMDGP=0) D
. S DLGIEN=+ORDIALOG,DGRP=$P(^ORD(101.41,+ORDIALOG,0),U,5)
D FORMID^ORWDXM(.FID,DLGIEN)
Q DLGIEN_U_TYP_U_FID_U_DGRP
;
CHKDSBL(LST,ID,MODE) ; return message if dialog disabled
; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
; LST=QL_REJECT + disabled message or unchanged
N PKG
S DLGIEN=+ID I MODE S DLGIEN=+$P($G(^OR(100,+ID,0)),U,5)
S X0=$G(^ORD(101.41,DLGIEN,0)),X=$P(X0,U,3)
I '$L(X),($P(X0,U,4)="Q") D ; check default dialog
. S DLGIEN=+$$DEFDLG^ORWDXQ($P(X0,U,5))
. S X=$P($G(^ORD(101.41,DLGIEN,0)),U,3)
I $L(X) D
. I MODE D GETTXT^ORWORR(.LST,ID) S LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -"
. S LST(0)="8^0",LST(.5)="Dialog Disabled: "_X
S PKG=$P(X0,"^",7) I PKG]"",$P($G(^DIC(9.4,PKG,0)),"^",2)="SD",'$$PATCH^XPDUTL("SD*5.3*671") S LST(0)="8^0",LST(.5)="Dialog Disabled: VSE patch SD*5.3*671 not installed"
Q
CHKVACT(LST,ID,MODE,ORNP) ; return message if action not valid
; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
; LST=QL_REJECT + invalid action message or unchanged
Q:'MODE ; not an action on an order
N X,ACT S ACT=$S(MODE=1:"RW",MODE=2:"XX",1:"")
D VALID^ORWDXA(.X,ID,ACT,ORNP)
I $L(X) D GETTXT^ORWORR(.LST,ID) D
. S LST(0)="8^0",LST(.5)=X,LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -"
Q
CHKCOPY(LST,ID,FLDS) ; return message if can't copy this order
; ID=ORIFN;ACT FLDS=EventType in 7th piece
; LST=QL_REJECT + cannot copy message or unchanged
I "^A^D^T^"'[(U_$E($P(FLDS,U,7))_U) Q ; not event delayed
N PKG S PKG=$P($G(^OR(100,+ID,0)),U,14)
S PKG=$$NMSP^ORCD(PKG) I PKG="OR"!(PKG="PS") Q ; xfer meds, generics
N ORWCAT S ORWCAT=$P($G(^OR(100,+ID,0)),U,12)
I ORWCAT="I",("^A^T^"[(U_$E($P(FLDS,U,7))_U)) Q ; admit, xfer inpt
I ORWCAT="O",$E($P(FLDS,U,7))="D" Q ; discharge outpt
D GETTXT^ORWORR(.LST,ID)
I ORWCAT="I" S LST(.5)="inpatient order to outpatient -"
I ORWCAT="O" S LST(.5)="outpatient order to inpatient -"
S:$D(LST(.5)) LST(.5)="Cannot copy the following "_LST(.5)
S LST(0)="8^0",LST(.7)=""
Q
BLD4CHG(LST,ID,FLDS) ; build responses for an edit
; ID=ORIFN;ACT FLDS=unused right now
; LST(0)=Qlvl^RespID(XOrderID)^DlgIEN^DlgType^FormID^DGrp
N OIDX,OI,CNT
S (OI,OIDX,CNT)=0
S:$D(^OR(100,+ID,4.5,"ID","ORDERABLE")) OIDX=$O(^OR(100,+ID,4.5,"ID","ORDERABLE",0))
I $D(^OR(100,+ID,4.5,OIDX)) D
. F S CNT=$O(^OR(100,+ID,4.5,OIDX,CNT)) Q:'CNT D
. . S OI=^(CNT) D VALDOI
I +LST(0)=8 S LST(.5)="You can not change this order." Q
S LST(0)="0^X"_ID_U_$$DLGINFO(+ID,2)
S $P(LST(0),U,4)="X"
Q
GETIVTYP() ;
N RESULT,TYPEIEN
S RESULT=""
S TYPEIEN=$O(^ORD(101.41,"B","OR GTX IV TYPE","")) I TYPEIEN'>0 Q RESULT
S RESULT=$G(ORDIALOG(TYPEIEN,1))
Q RESULT
;
ISTUBEQO(IFN) ;
N DG,DIAL
S DG=+$P($G(^ORD(101.41,IFN,0)),U,5)
S DIAL=$P($G(^ORD(100.98,DG,0)),U,4)
I +$G(DIAL)=0 Q 0
I $P($G(^ORD(101.41,DIAL,0)),U)="FHW8" Q 1
Q 0
VALDOI ; Validate the Orderable Items
N ORQUIT,ORPS
I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D
. S ORQUIT=1
. S LST(0)="8^0"
I $D(ORQUIT) Q:ORQUIT
S ORPS=$G(^ORD(101.43,+OI,"PS"))
I $P(ORPS,U,1,4)="0^0^0^0",($P(ORPS,U,7)=0) S LST(0)="8^0"
Q
VERDUR(ORDIALOG) ;
;check for duration value if a THEN conjunation is used
N CONJ,CONVALUE,DUR,I,SUCC
S SUCC=1
S CONJ=$$PTR^ORCDPS1("AND/THEN")
S DUR=$$PTR^ORCDPS1("DURATION")
S I=0 F S I=$O(ORDIALOG(CONJ,I)) Q:I'>0!(SUCC=0) D
. I $$UP^XLFSTR($E($G(ORDIALOG(CONJ,I)),1))="T" D
. . I '$L($G(ORDIALOG(DUR,I))) S SUCC=0
Q SUCC
;
VERORD(OIEN,ORVP) ;
N IFN,INFUSE,INFUID,ODG,ODP,ASSIV,SUCC,TYPE
S SUCC=0,IFN=ORDIALOG
S ODP=+$P($G(^ORD(101.41,+IFN,0)),U,7),ODG=+$P($G(^(0)),U,5)
S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3)
I ODP'["PS" Q 1
I ODP="PSH" Q 1
;check infusion rate for IV QO
I ODG="IV RX"!(ODG="TPN") D Q SUCC
.S TYPE=$$GETIVTYP
.I TYPE="" Q
.S PASSIV=$$IVRTECHK
.I PASSIV=0 Q
.S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
.S INFUSE=$G(ORDIALOG(INFUID,1))
.S SUCC=$$VALINF(TYPE,INFUSE)
.I SUCC=0 Q
.I TYPE="C" S SUCC=$$IVADFCHK(.ORDIALOG)
I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" S SUCC=$$VERDUR(.ORDIALOG) I SUCC=0 Q SUCC
I ODP="PSO" S SUCC=$$VALDS(.ORDIALOG,$G(ORVP))
Q SUCC
;
VALINF(TYPE,INFUSE) ;
N SUCC
S SUCC=0
I TYPE="I" D Q SUCC
.I INFUSE="" S SUCC=1 Q
.I $TR(INFUSE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["INFUSE OVER" S SUCC=1 Q
.I $L(INFUSE)>4 Q
Q 1
;
VALQO(IFN,ORVP) ;Check to see if it's a good QO med
;If it's an IV QO: check if infusion rate entered
;If it's an UD QO: check if dosage entered
;regular order treated as good QO
;
I IFN[";",($$UPCTCHK^ORWDXA(+IFN)) Q 0
I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1
N ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE,PRIORID,DONEID,OK
S SUCC=0
S ODP=+$P($G(^ORD(101.41,IFN,0)),U,7),ODG=+$P($G(^(0)),U,5)
S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3)
I ODP'["PS" Q 1
I ODP="PSH" Q 1
;check for DONE urgency/priority on Outpatient QO
I ODG="O RX" D Q:'OK 0
. S OK=1,PRIORID=$O(^ORD(101.41,"B","OR GTX URGENCY",0)) Q:'PRIORID
. S DONEID=$O(^ORD(101.42,"B","DONE",0)) Q:'DONEID
. I $G(ORDIALOG(PRIORID,1))=DONEID S OK=0
;check infusion rate for IV QO
I ODG="IV RX"!(ODG="TPN")!(ODG="CI RX") D
. S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
. S TYPE=$$GETIVTYP
. I TYPE="" Q
. I $D(ORDIALOG(INFUID,1)) D
. . I TYPE="I" D Q
. . . S INFUSE=$G(ORDIALOG(INFUID,1))
. . . I INFUSE="" Q
. . . I INFUSE["INFUSE OVER" S SUCC=1 Q
. . . I $L(INFUSE)>4 Q
. . . I +INFUSE>0 S INFUSE="INFUSE OVER "_INFUSE_" Minutes"
. . . S ORDIALOG(INFUID,1)=INFUSE,SUCC=1
. . S SUCC=1
. ; additive frequency check/infusion rate checks for continuous orders
. I TYPE="C" D I SUCC=0 Q
. . I $D(ORDIALOG(INFUID,1)) S SUCC=1 I SUCC=0 Q
. . S SUCC=$$IVADFCHK(.ORDIALOG)
. I SUCC=0 Q
. I '$D(ORDIALOG(INFUID,1)),TYPE="I" S SUCC=1
. S PASSIV=$$IVRTECHK
. I SUCC=0 Q
. I PASSIV=0 S SUCC=0
. I SUCC=1,$$ISMISSFL(.ORDIALOG,TYPE)=1 S SUCC=0
;check dosage for UD QO
I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" D
. S DSAGEID=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
. I $D(ORDIALOG(DSAGEID,1)) S SUCC=1
. I SUCC=0 Q
. ;
. S SUCC=$$VERDUR(.ORDIALOG) I SUCC=0 Q
. I ODP="PSO",+$G(ORVP)>0 S SUCC=$$VALDS(.ORDIALOG,$G(ORVP))
;
I SUCC=1,$P($G(^ORD(101.41,IFN,5)),U,8) D
.N COMMID,WPCNT
.S COMMID=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
.S COMMID=$O(^ORD(101.41,IFN,6,"D",COMMID,0))
.I COMMID S WPCNT=0 F S WPCNT=$O(^ORD(101.41,IFN,6,COMMID,2,WPCNT)) Q:'WPCNT!('SUCC) D
..I ^ORD(101.41,IFN,6,COMMID,2,WPCNT,0)["^" S SUCC=0
Q SUCC
;
VALRADQO(ORDIALOG) ;
N ORID,ORVALUE
;check urgency
S ORID=$P($G(ORDIALOG("B","URGENCY")),U,2)
I ORID'>0 Q 0
S ORVALUE=$G(ORDIALOG(ORID,1))
I ORVALUE'>0 Q 0
I '$$RADURG^ORWDRA32(ORVALUE) Q 0
Q 1
;
ISRAD(ORIFN) ;
N ORPKG
I 'ORWMODE S ORPKG=$P($G(^ORD(101.41,+ORIFN,0)),U,7)
E S ORPKG=$P($G(^OR(100,+ORIFN,0)),U,14)
Q $$NMSP^ORCD(ORPKG)="RA"
;
IVRTECHK() ;
N RTIEN,RTVALUE,RESULT
N CNT,NUM,ORDERIDS,OIIEN,OTYPE,ROUTE
S CNT=0,RESULT=0
S RTIEN=+$P($G(ORDIALOG("B","ROUTE")),U,2) I RTIEN'>0 Q RESULT
S RTVALUE=+$G(ORDIALOG(RTIEN,1)) I RTVALUE'>0 Q RESULT
F OTYPE="SOLUTION","ADDITIVE" D
.S OIIEN=+$P($G(ORDIALOG("B",OTYPE)),U,2) I OIIEN>0 D
..S NUM=0 F S NUM=$O(ORDIALOG(OIIEN,NUM)) Q:NUM'>0 I +$G(ORDIALOG(OIIEN,NUM))>0 D
...S CNT=CNT+1,ORDERIDS(CNT)=ORDIALOG(OIIEN,NUM)
I $D(ORDERIDS)=0 Q
S ROUTE=$$IVQOVAL^ORWDPS33(.ORDERIDS,RTVALUE)
I ROUTE="" S ORDIALOG(RTIEN,1)=ROUTE
I ROUTE'="" S RESULT=1
;K ^TMP($J,"ORWDXM3 IVRTECHK")
;D ALL^PSS51P2(RTVALUE,,,,"ORWDXM3 IVRTECHK")
;I +^TMP($J,"ORWDXM3 IVRTECHK",RTVALUE,6)'=1 S ORDIALOG(RTIEN,1)="",RESULT=0
;K ^TMP($J,"ORWDXM3 IVRTECHK")
Q RESULT
;
ISUDQO(ORY,DLGID) ;True: is unit dose quick order
S ORY=0
Q:'$D(^ORD(101.41,DLGID,0))
N CLODGRP,CLIVDGRP,UDGRP1,UDGRP2,DLGTYP,DLGGRP
S UDGRP1=$O(^ORD(100.98,"B","UD RX",0))
S UDGRP2=$O(^ORD(100.98,"B","I RX",0))
S CLODGRP=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",""))
S CLIVDGRP=$O(^ORD(100.98,"B","CLINIC INFUSIONS",""))
S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4)
I DLGTYP="Q" D VERIFY^ORQOAUIC(.ORORN1,DLGID) I $G(ORORN1) D
. S ^TMP("OR QUICK ORDER AUDIT",$J,"DLGID")=DLGID ;RTW
S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5)
I (DLGTYP="Q"),((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)!(DLGGRP=CLIVDGRP)) S ORY=1
Q
;
SDRTCVER(ORDIALOG) ;
;Return to Clinic QO verifier
I +$$VAL^ORCD("NUMBER OF APPOINTMENTS")>1,+$$VAL^ORCD("INTERVAL")<1 Q 0
I +$$VAL^ORCD("NUMBER OF APPOINTMENTS")=1,+$$VAL^ORCD("INTERVAL")>0 Q 0
Q 1
;
VALDS(ORDIALOG,ORVP) ;
N ARRAY,DAYS,DOSE,DOSENUM,DRUG,DS,IDX,ISCLOZ,LASTAND,LASTDAYS,LASTIDX,MAXDS,MAXQTY,OI,QTY
N REFILL,RESULT,SCH,STOP,TEMP,TITRATION,TOTALDAY,UNIT,VALUE,X
S RESULT=1
;build value strings for prompts in dialog, build array for conjunction and duration for complex orders
S SCH="",DRUG="",UNIT="",DOSENUM=0,TITRATION=0,DS=0,OI=""
F X="AND/THEN","DAYS SUPPLY","DOSE","DURATION","ORDERABLE ITEM","QUANTITY","REFILLS","SCHEDULE","TITRATION" D
.S TEMP=$$PTR^ORCD("OR GTX "_X)
.S IDX=0 F S IDX=$O(ORDIALOG(TEMP,IDX)) Q:IDX'>0 D
..S VALUE=$G(ORDIALOG(TEMP,IDX))
..I X="DAYS SUPPLY" S DS=VALUE Q
..I X="REFILL" S REFILL=VALUE Q
..I X="QUANTITY" S QTY=VALUE Q
..I X="DOSE" S UNIT=UNIT_$P(VALUE,"&",3)_U,DRUG=DRUG_$P(VALUE,"&",6)_U,DOSENUM=DOSENUM+1 Q
..I X="ORDERABLE ITEM" S OI=VALUE Q
..I X="SCHEDULE" S SCH=SCH_VALUE_U Q
..I X="AND/THEN" S $P(ARRAY(IDX),U)=VALUE Q
..I X="DURATION" S $P(ARRAY(IDX),U,2)=VALUE Q
..I X="TITRATION" S TITRATION=+VALUE Q
..I X="REFILLS" S REFILL=VALUE
;detemine if order if for a Clozapine order
S ISCLOZ=$$ISCLOZ^ORALWORD(OI)
I 'ISCLOZ D Q RESULT
.;get MAXDS from pharmacy for non-clozapine orders
.I DOSENUM>1 S DRUG=""
.I DOSENUM=1,DRUG'="" S DRUG=+DRUG
.D MAXDS^ORWDPS1(.MAXDS,OI,DRUG)
.I MAXDS>0,MAXDS<DS S RESULT=0
;Clozapine checks
S DRUG=+DRUG
;Day Supply Checks
D CLZDS^ORWDPS33(.TEMP,+ORVP,DRUG,DS,OI)
I +TEMP=0 S RESULT=0 Q RESULT
;build duration string for complex orders
S DUR=$S($D(ARRAY):$$BLDDUR(.ARRAY),1:"~^")
;Quantity Checks
D DAY2QTY^ORWDPS2(.MAXQTY,DS,UNIT,SCH,DUR,+ORVP,DRUG)
I MAXQTY>0,MAXQTY<QTY S RESULT=0
Q RESULT
;
BLDDUR(ARRAY) ;
N CONJ,DUR,LASTCONJ,LASTDUR,LASTIDX,NOLASTDUR,RESULT,TOTALDAY,X
S LASTCONJ="",LASTDUR="",RESULT=""
S LASTIDX=$O(ARRAY(""),-1)
S X=0 F S X=$O(ARRAY(X)) Q:X'>0 D
.S CONJ=$P(ARRAY(X),U),DUR=$P(ARRAY(X),U,2)
.I CONJ'="",LASTCONJ'=CONJ S LASTCONJ=CONJ
.I CONJ="A",DUR'="" S LASTDUR=+DUR
.I DUR="",LASTCONJ="A" S DUR=LASTDUR
.S RESULT=RESULT_DUR_"~"_CONJ_U
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXM3 15571 printed Jun 11, 2024@22:17:13 Page 2
ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;Sep 13, 2022@13:32:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243,303,296,280,350,434,441,397,377,498,405**;Dec 17, 1997;Build 211
+2 ;
+3 ;
+4 ;
VALCOUNT(NAME,ORDIALOG) ;
+1 NEW COUNT,IEN,NUM
+2 SET NUM=0
SET COUNT=0
+3 SET IEN=$PIECE($GET(ORDIALOG("B",NAME)),U,2)
if IEN'>0
QUIT
+4 FOR
SET NUM=$ORDER(ORDIALOG(IEN,NUM))
if +NUM'>0
QUIT
SET COUNT=COUNT+1
+5 QUIT COUNT
+6 ;
ISMISSFL(ORDIALOG,IVTYPE) ;
+1 NEW ADDCNT,RESULT,SOLCNT,STRCNT
+2 SET RESULT=0
+3 SET ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
+4 SET STRCNT=$$VALCOUNT("STRENGTH",.ORDIALOG)
+5 SET SOLCNT=$$VALCOUNT("SOLUTION",.ORDIALOG)
+6 IF IVTYPE'="I"
IF ADDCNT'=STRCNT
SET RESULT=1
+7 IF IVTYPE="I"
Begin DoDot:1
+8 IF ADDCNT=0
IF SOLCNT>0
QUIT
+9 IF ADDCNT=0
SET RESULT=1
QUIT
+10 IF ADDCNT'=STRCNT
SET RESULT=1
QUIT
End DoDot:1
+11 QUIT RESULT
+12 ;
IVADFCHK(ORDIALOG) ;
+1 ; This line tag checks to see if there are the same number of values
+2 ;for ADDITIVE and Additive Frequency. This also checks to see if
+3 ;the value assigned to ADDFREQ is one of the three possible values
+4 ;All Bags, 1 bag/day, See Comments. If See Comments it also checks
+5 ;for text in the comment section.
+6 NEW ADDCNT,ADDFCNT,ADDFREQ,COMMENT,FREQ,INST,RESULT
+7 SET ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
+8 SET ADDFCNT=$$VALCOUNT("ADDITIVE FREQUENCY",.ORDIALOG)
+9 IF ADDCNT'=ADDFCNT
QUIT 0
+10 SET ADDFREQ=$ORDER(^ORD(101.41,"AB","OR GTX ADDITIVE FREQUENCY",""))
+11 SET COMMENT=$ORDER(^ORD(101.41,"AB","OR GTX WORD PROCESSING 1",""))
+12 IF +$GET(ADDFREQ)'>0
QUIT 0
+13 SET INST=0
SET RESULT=1
+14 FOR
SET INST=$ORDER(ORDIALOG(ADDFREQ,INST))
if INST'>0!(RESULT=0)
QUIT
Begin DoDot:1
+15 SET FREQ=$$ADDFRQCV^ORMBLDP1($GET(ORDIALOG(ADDFREQ,INST)),"O")
+16 IF FREQ="A"!(FREQ=1)
QUIT
+17 IF FREQ=""
SET RESULT=0
QUIT
+18 IF FREQ="S"
IF '$LENGTH($GET(ORDIALOG(COMMENT,1)))
SET RESULT=0
QUIT
End DoDot:1
+19 QUIT RESULT
+20 ;
KEYVAR(DLG) ; Parse entry action for key variables & return in string
+1 ; RV=CollTp^Samp^Spec^CollDt^Urg^Sched^NoComm^NoDiag^NoProv^NoRsn
+2 NEW XCODE,RV,POS,Z
+3 SET XCODE=$GET(^ORD(101.41,DLG,3))
SET RV=""
+4 IF '$LENGTH(XCODE)
QUIT ""
+5 SET POS=$FIND(XCODE,"LRFZX=")
IF POS
SET $PIECE(RV,U,1)=$$VALUE(XCODE,POS)
+6 SET POS=$FIND(XCODE,"LRFSAMP=")
IF POS
SET $PIECE(RV,U,2)=$$VALUE(XCODE,POS)
+7 SET POS=$FIND(XCODE,"LRFSPEC=")
IF POS
SET $PIECE(RV,U,3)=$$VALUE(XCODE,POS)
+8 SET POS=$FIND(XCODE,"LRFDATE=")
IF POS
SET $PIECE(RV,U,4)=$$VALUE(XCODE,POS)
+9 SET POS=$FIND(XCODE,"LRFURG=")
IF POS
SET $PIECE(RV,U,5)=$$VALUE(XCODE,POS)
+10 SET POS=$FIND(XCODE,"LRFSCH=")
IF POS
SET $PIECE(RV,U,6)=$$VALUE(XCODE,POS)
+11 SET POS=$FIND(XCODE,"PSJNOPC=")
IF POS
SET $PIECE(RV,U,7)=$$VALUE(XCODE,POS)
+12 SET POS=$FIND(XCODE,"GMRCNOPD=")
IF POS
SET $PIECE(RV,U,8)=$$VALUE(XCODE,POS)
+13 SET POS=$FIND(XCODE,"GMRCNOAT=")
IF POS
SET $PIECE(RV,U,9)=$$VALUE(XCODE,POS)
+14 SET POS=$FIND(XCODE,"GMRCREAF=")
IF POS
SET $PIECE(RV,U,10)=$$VALUE(XCODE,POS)
+15 SET POS=$FIND(XCODE,"ORFORGET=")
IF POS
Begin DoDot:1
+16 ; need to change this so that it is executed in SETKEYV so
+17 ; that it is executed each time menu is revisited
+18 NEW ORFORGET
SET ORFORGET=$$VALUE(XCODE,POS)
+19 IF ORFORGET
KILL ^TMP("ORECALL",$JOB,+ORFORGET)
+20 IF '$TEST
KILL ^TMP("ORECALL",$JOB)
End DoDot:1
+21 QUIT RV
VALUE(STR,BEG) ; Return value of "var=" (copied from ORCONVRT)
+1 NEW X,Y,I
SET X=$EXTRACT(STR,BEG,999)
SET Y=""
+2 ; strip leading "
if $EXTRACT(X)=""""
SET X=$EXTRACT(X,2,999)
+3 FOR I=1:1:$LENGTH(X)
SET Z=$EXTRACT(X,I)
if (Z=",")!(Z=" ")!(Z="""")
QUIT
SET Y=Y_Z
+4 QUIT $TRANSLATE(Y,U,"")
+5 ;
SETKEYV(X) ; Set the key variables based on contents of X
+1 IF $LENGTH($PIECE(X,U,1))
SET LRFZX=$PIECE(X,U,1)
+2 IF $LENGTH($PIECE(X,U,2))
SET LRFSAMP=$PIECE(X,U,2)
+3 IF $LENGTH($PIECE(X,U,3))
SET LRFSPEC=$PIECE(X,U,3)
+4 IF $LENGTH($PIECE(X,U,4))
SET LRFDATE=$PIECE(X,U,4)
+5 IF $LENGTH($PIECE(X,U,5))
SET LRFURG=$PIECE(X,U,5)
+6 IF $LENGTH($PIECE(X,U,6))
SET LRFSCH=$PIECE(X,U,6)
+7 IF $LENGTH($PIECE(X,U,7))
SET PSJNOPC=$PIECE(X,U,7)
+8 IF $LENGTH($PIECE(X,U,8))
SET GMRCNOPD=$PIECE(X,U,8)
+9 IF $LENGTH($PIECE(X,U,9))
SET GMRCNOAT=$PIECE(X,U,9)
+10 IF $LENGTH($PIECE(X,U,10))
SET GMRCREAF=$PIECE(X,U,10)
+11 QUIT
DLGINFO(IEN,MODE) ; return information about a dialog
+1 ; IEN=DlgIEN or ORIFN, MODE=0:Dlg,1:Copy,2:Change
+2 ; RESULT=DlgIEN^DlgType^FormID^DGrp
+3 ; If MODE="1;T",don't check "PS MEDS" for transfer order
+4 ; PSMDGP=1: Unit/Dose Group
+5 ; PSMDGP=2: OutPatient Group
+6 NEW X0,DLGIEN,TYP,FID,DGRP,PSMDGP,ISXF
+7 SET PSMDGP=0
SET ISXF=""
+8 SET ISXF=$PIECE(MODE,";",2)
+9 SET MODE=+MODE
+10 SET DLGIEN=IEN
IF MODE
IF (ISXF'="T")
Begin DoDot:1
+11 SET DLGIEN=+$PIECE($GET(^OR(100,+IEN,0)),U,5)
+12 IF $PIECE(^ORD(101.41,DLGIEN,0),U)="PS MEDS"
Begin DoDot:2
+13 NEW PTCAT
SET PTCAT=$PIECE($GET(^OR(100,+IEN,0)),U,12)
+14 IF PTCAT="I"
SET DLGIEN=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
SET PSMDGP=1
+15 IF PTCAT="O"
SET DLGIEN=$ORDER(^ORD(101.41,"B","PSO OERR",0))
SET PSMDGP=2
End DoDot:2
End DoDot:1
+16 IF MODE
IF (ISXF="T")
SET DLGIEN=+$PIECE($GET(^OR(100,+IEN,0)),U,5)
+17 SET X0=$GET(^ORD(101.41,DLGIEN,0))
SET TYP=$PIECE(X0,U,4)
SET DGRP=$PIECE(X0,U,5)
+18 IF MODE
SET DGRP=+$PIECE($GET(^OR(100,+IEN,0)),U,11)
+19 ;JD NEW START 11/13/02
+20 IF DLGIEN=$ORDER(^ORD(101.41,"B","PSJ OR PAT OE",0))
SET PSMDGP=1
+21 IF DLGIEN=$ORDER(^ORD(101.41,"B","PSO OERR",0))
SET PSMDGP=2
+22 ;JD NEW END 11/13/02
+23 ; for copy or change, if the base dialog has changed, use it's info
+24 IF MODE
IF $GET(ORDIALOG)
IF (+DLGIEN'=+ORDIALOG)
IF (PSMDGP=0)
Begin DoDot:1
+25 SET DLGIEN=+ORDIALOG
SET DGRP=$PIECE(^ORD(101.41,+ORDIALOG,0),U,5)
End DoDot:1
+26 DO FORMID^ORWDXM(.FID,DLGIEN)
+27 QUIT DLGIEN_U_TYP_U_FID_U_DGRP
+28 ;
CHKDSBL(LST,ID,MODE) ; return message if dialog disabled
+1 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
+2 ; LST=QL_REJECT + disabled message or unchanged
+3 NEW PKG
+4 SET DLGIEN=+ID
IF MODE
SET DLGIEN=+$PIECE($GET(^OR(100,+ID,0)),U,5)
+5 SET X0=$GET(^ORD(101.41,DLGIEN,0))
SET X=$PIECE(X0,U,3)
+6 ; check default dialog
IF '$LENGTH(X)
IF ($PIECE(X0,U,4)="Q")
Begin DoDot:1
+7 SET DLGIEN=+$$DEFDLG^ORWDXQ($PIECE(X0,U,5))
+8 SET X=$PIECE($GET(^ORD(101.41,DLGIEN,0)),U,3)
End DoDot:1
+9 IF $LENGTH(X)
Begin DoDot:1
+10 IF MODE
DO GETTXT^ORWORR(.LST,ID)
SET LST(.6)=""
SET LST(.7)="Cannot "_$SELECT(MODE=1:"Copy",1:"Change")_" -"
+11 SET LST(0)="8^0"
SET LST(.5)="Dialog Disabled: "_X
End DoDot:1
+12 SET PKG=$PIECE(X0,"^",7)
IF PKG]""
IF $PIECE($GET(^DIC(9.4,PKG,0)),"^",2)="SD"
IF '$$PATCH^XPDUTL("SD*5.3*671")
SET LST(0)="8^0"
SET LST(.5)="Dialog Disabled: VSE patch SD*5.3*671 not installed"
+13 QUIT
CHKVACT(LST,ID,MODE,ORNP) ; return message if action not valid
+1 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
+2 ; LST=QL_REJECT + invalid action message or unchanged
+3 ; not an action on an order
if 'MODE
QUIT
+4 NEW X,ACT
SET ACT=$SELECT(MODE=1:"RW",MODE=2:"XX",1:"")
+5 DO VALID^ORWDXA(.X,ID,ACT,ORNP)
+6 IF $LENGTH(X)
DO GETTXT^ORWORR(.LST,ID)
Begin DoDot:1
+7 SET LST(0)="8^0"
SET LST(.5)=X
SET LST(.6)=""
SET LST(.7)="Cannot "_$SELECT(MODE=1:"Copy",1:"Change")_" -"
End DoDot:1
+8 QUIT
CHKCOPY(LST,ID,FLDS) ; return message if can't copy this order
+1 ; ID=ORIFN;ACT FLDS=EventType in 7th piece
+2 ; LST=QL_REJECT + cannot copy message or unchanged
+3 ; not event delayed
IF "^A^D^T^"'[(U_$EXTRACT($PIECE(FLDS,U,7))_U)
QUIT
+4 NEW PKG
SET PKG=$PIECE($GET(^OR(100,+ID,0)),U,14)
+5 ; xfer meds, generics
SET PKG=$$NMSP^ORCD(PKG)
IF PKG="OR"!(PKG="PS")
QUIT
+6 NEW ORWCAT
SET ORWCAT=$PIECE($GET(^OR(100,+ID,0)),U,12)
+7 ; admit, xfer inpt
IF ORWCAT="I"
IF ("^A^T^"[(U_$EXTRACT($PIECE(FLDS,U,7))_U))
QUIT
+8 ; discharge outpt
IF ORWCAT="O"
IF $EXTRACT($PIECE(FLDS,U,7))="D"
QUIT
+9 DO GETTXT^ORWORR(.LST,ID)
+10 IF ORWCAT="I"
SET LST(.5)="inpatient order to outpatient -"
+11 IF ORWCAT="O"
SET LST(.5)="outpatient order to inpatient -"
+12 if $DATA(LST(.5))
SET LST(.5)="Cannot copy the following "_LST(.5)
+13 SET LST(0)="8^0"
SET LST(.7)=""
+14 QUIT
BLD4CHG(LST,ID,FLDS) ; build responses for an edit
+1 ; ID=ORIFN;ACT FLDS=unused right now
+2 ; LST(0)=Qlvl^RespID(XOrderID)^DlgIEN^DlgType^FormID^DGrp
+3 NEW OIDX,OI,CNT
+4 SET (OI,OIDX,CNT)=0
+5 if $DATA(^OR(100,+ID,4.5,"ID","ORDERABLE"))
SET OIDX=$ORDER(^OR(100,+ID,4.5,"ID","ORDERABLE",0))
+6 IF $DATA(^OR(100,+ID,4.5,OIDX))
Begin DoDot:1
+7 FOR
SET CNT=$ORDER(^OR(100,+ID,4.5,OIDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+8 SET OI=^(CNT)
DO VALDOI
End DoDot:2
End DoDot:1
+9 IF +LST(0)=8
SET LST(.5)="You can not change this order."
QUIT
+10 SET LST(0)="0^X"_ID_U_$$DLGINFO(+ID,2)
+11 SET $PIECE(LST(0),U,4)="X"
+12 QUIT
GETIVTYP() ;
+1 NEW RESULT,TYPEIEN
+2 SET RESULT=""
+3 SET TYPEIEN=$ORDER(^ORD(101.41,"B","OR GTX IV TYPE",""))
IF TYPEIEN'>0
QUIT RESULT
+4 SET RESULT=$GET(ORDIALOG(TYPEIEN,1))
+5 QUIT RESULT
+6 ;
ISTUBEQO(IFN) ;
+1 NEW DG,DIAL
+2 SET DG=+$PIECE($GET(^ORD(101.41,IFN,0)),U,5)
+3 SET DIAL=$PIECE($GET(^ORD(100.98,DG,0)),U,4)
+4 IF +$GET(DIAL)=0
QUIT 0
+5 IF $PIECE($GET(^ORD(101.41,DIAL,0)),U)="FHW8"
QUIT 1
+6 QUIT 0
VALDOI ; Validate the Orderable Items
+1 NEW ORQUIT,ORPS
+2 IF $GET(^ORD(101.43,OI,.1))
IF ^(.1)'>$$NOW^XLFDT
Begin DoDot:1
+3 SET ORQUIT=1
+4 SET LST(0)="8^0"
End DoDot:1
+5 IF $DATA(ORQUIT)
if ORQUIT
QUIT
+6 SET ORPS=$GET(^ORD(101.43,+OI,"PS"))
+7 IF $PIECE(ORPS,U,1,4)="0^0^0^0"
IF ($PIECE(ORPS,U,7)=0)
SET LST(0)="8^0"
+8 QUIT
VERDUR(ORDIALOG) ;
+1 ;check for duration value if a THEN conjunation is used
+2 NEW CONJ,CONVALUE,DUR,I,SUCC
+3 SET SUCC=1
+4 SET CONJ=$$PTR^ORCDPS1("AND/THEN")
+5 SET DUR=$$PTR^ORCDPS1("DURATION")
+6 SET I=0
FOR
SET I=$ORDER(ORDIALOG(CONJ,I))
if I'>0!(SUCC=0)
QUIT
Begin DoDot:1
+7 IF $$UP^XLFSTR($EXTRACT($GET(ORDIALOG(CONJ,I)),1))="T"
Begin DoDot:2
+8 IF '$LENGTH($GET(ORDIALOG(DUR,I)))
SET SUCC=0
End DoDot:2
End DoDot:1
+9 QUIT SUCC
+10 ;
VERORD(OIEN,ORVP) ;
+1 NEW IFN,INFUSE,INFUID,ODG,ODP,ASSIV,SUCC,TYPE
+2 SET SUCC=0
SET IFN=ORDIALOG
+3 SET ODP=+$PIECE($GET(^ORD(101.41,+IFN,0)),U,7)
SET ODG=+$PIECE($GET(^(0)),U,5)
+4 SET ODP=$$GET1^DIQ(9.4,+ODP_",",1)
SET ODG=$PIECE($GET(^ORD(100.98,ODG,0)),U,3)
+5 IF ODP'["PS"
QUIT 1
+6 IF ODP="PSH"
QUIT 1
+7 ;check infusion rate for IV QO
+8 IF ODG="IV RX"!(ODG="TPN")
Begin DoDot:1
+9 SET TYPE=$$GETIVTYP
+10 IF TYPE=""
QUIT
+11 SET PASSIV=$$IVRTECHK
+12 IF PASSIV=0
QUIT
+13 SET INFUID=$ORDER(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
+14 SET INFUSE=$GET(ORDIALOG(INFUID,1))
+15 SET SUCC=$$VALINF(TYPE,INFUSE)
+16 IF SUCC=0
QUIT
+17 IF TYPE="C"
SET SUCC=$$IVADFCHK(.ORDIALOG)
End DoDot:1
QUIT SUCC
+18 IF (ODP="PSJ")!(ODP="PSO")
IF ODG'="IV RX"
IF ODG'="TPN"
SET SUCC=$$VERDUR(.ORDIALOG)
IF SUCC=0
QUIT SUCC
+19 IF ODP="PSO"
SET SUCC=$$VALDS(.ORDIALOG,$GET(ORVP))
+20 QUIT SUCC
+21 ;
VALINF(TYPE,INFUSE) ;
+1 NEW SUCC
+2 SET SUCC=0
+3 IF TYPE="I"
Begin DoDot:1
+4 IF INFUSE=""
SET SUCC=1
QUIT
+5 IF $TRANSLATE(INFUSE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["INFUSE OVER"
SET SUCC=1
QUIT
+6 IF $LENGTH(INFUSE)>4
QUIT
End DoDot:1
QUIT SUCC
+7 QUIT 1
+8 ;
VALQO(IFN,ORVP) ;Check to see if it's a good QO med
+1 ;If it's an IV QO: check if infusion rate entered
+2 ;If it's an UD QO: check if dosage entered
+3 ;regular order treated as good QO
+4 ;
+5 IF IFN[";"
IF ($$UPCTCHK^ORWDXA(+IFN))
QUIT 0
+6 IF $PIECE($GET(^ORD(101.41,IFN,0)),U,4)'="Q"
QUIT 1
+7 NEW ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE,PRIORID,DONEID,OK
+8 SET SUCC=0
+9 SET ODP=+$PIECE($GET(^ORD(101.41,IFN,0)),U,7)
SET ODG=+$PIECE($GET(^(0)),U,5)
+10 SET ODP=$$GET1^DIQ(9.4,+ODP_",",1)
SET ODG=$PIECE($GET(^ORD(100.98,ODG,0)),U,3)
+11 IF ODP'["PS"
QUIT 1
+12 IF ODP="PSH"
QUIT 1
+13 ;check for DONE urgency/priority on Outpatient QO
+14 IF ODG="O RX"
Begin DoDot:1
+15 SET OK=1
SET PRIORID=$ORDER(^ORD(101.41,"B","OR GTX URGENCY",0))
if 'PRIORID
QUIT
+16 SET DONEID=$ORDER(^ORD(101.42,"B","DONE",0))
if 'DONEID
QUIT
+17 IF $GET(ORDIALOG(PRIORID,1))=DONEID
SET OK=0
End DoDot:1
if 'OK
QUIT 0
+18 ;check infusion rate for IV QO
+19 IF ODG="IV RX"!(ODG="TPN")!(ODG="CI RX")
Begin DoDot:1
+20 SET INFUID=$ORDER(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
+21 SET TYPE=$$GETIVTYP
+22 IF TYPE=""
QUIT
+23 IF $DATA(ORDIALOG(INFUID,1))
Begin DoDot:2
+24 IF TYPE="I"
Begin DoDot:3
+25 SET INFUSE=$GET(ORDIALOG(INFUID,1))
+26 IF INFUSE=""
QUIT
+27 IF INFUSE["INFUSE OVER"
SET SUCC=1
QUIT
+28 IF $LENGTH(INFUSE)>4
QUIT
+29 IF +INFUSE>0
SET INFUSE="INFUSE OVER "_INFUSE_" Minutes"
+30 SET ORDIALOG(INFUID,1)=INFUSE
SET SUCC=1
End DoDot:3
QUIT
+31 SET SUCC=1
End DoDot:2
+32 ; additive frequency check/infusion rate checks for continuous orders
+33 IF TYPE="C"
Begin DoDot:2
+34 IF $DATA(ORDIALOG(INFUID,1))
SET SUCC=1
IF SUCC=0
QUIT
+35 SET SUCC=$$IVADFCHK(.ORDIALOG)
End DoDot:2
IF SUCC=0
QUIT
+36 IF SUCC=0
QUIT
+37 IF '$DATA(ORDIALOG(INFUID,1))
IF TYPE="I"
SET SUCC=1
+38 SET PASSIV=$$IVRTECHK
+39 IF SUCC=0
QUIT
+40 IF PASSIV=0
SET SUCC=0
+41 IF SUCC=1
IF $$ISMISSFL(.ORDIALOG,TYPE)=1
SET SUCC=0
End DoDot:1
+42 ;check dosage for UD QO
+43 IF (ODP="PSJ")!(ODP="PSO")
IF ODG'="IV RX"
IF ODG'="TPN"
Begin DoDot:1
+44 SET DSAGEID=$ORDER(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
+45 IF $DATA(ORDIALOG(DSAGEID,1))
SET SUCC=1
+46 IF SUCC=0
QUIT
+47 ;
+48 SET SUCC=$$VERDUR(.ORDIALOG)
IF SUCC=0
QUIT
+49 IF ODP="PSO"
IF +$GET(ORVP)>0
SET SUCC=$$VALDS(.ORDIALOG,$GET(ORVP))
End DoDot:1
+50 ;
+51 IF SUCC=1
IF $PIECE($GET(^ORD(101.41,IFN,5)),U,8)
Begin DoDot:1
+52 NEW COMMID,WPCNT
+53 SET COMMID=$ORDER(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
+54 SET COMMID=$ORDER(^ORD(101.41,IFN,6,"D",COMMID,0))
+55 IF COMMID
SET WPCNT=0
FOR
SET WPCNT=$ORDER(^ORD(101.41,IFN,6,COMMID,2,WPCNT))
if 'WPCNT!('SUCC)
QUIT
Begin DoDot:2
+56 IF ^ORD(101.41,IFN,6,COMMID,2,WPCNT,0)["^"
SET SUCC=0
End DoDot:2
End DoDot:1
+57 QUIT SUCC
+58 ;
VALRADQO(ORDIALOG) ;
+1 NEW ORID,ORVALUE
+2 ;check urgency
+3 SET ORID=$PIECE($GET(ORDIALOG("B","URGENCY")),U,2)
+4 IF ORID'>0
QUIT 0
+5 SET ORVALUE=$GET(ORDIALOG(ORID,1))
+6 IF ORVALUE'>0
QUIT 0
+7 IF '$$RADURG^ORWDRA32(ORVALUE)
QUIT 0
+8 QUIT 1
+9 ;
ISRAD(ORIFN) ;
+1 NEW ORPKG
+2 IF 'ORWMODE
SET ORPKG=$PIECE($GET(^ORD(101.41,+ORIFN,0)),U,7)
+3 IF '$TEST
SET ORPKG=$PIECE($GET(^OR(100,+ORIFN,0)),U,14)
+4 QUIT $$NMSP^ORCD(ORPKG)="RA"
+5 ;
IVRTECHK() ;
+1 NEW RTIEN,RTVALUE,RESULT
+2 NEW CNT,NUM,ORDERIDS,OIIEN,OTYPE,ROUTE
+3 SET CNT=0
SET RESULT=0
+4 SET RTIEN=+$PIECE($GET(ORDIALOG("B","ROUTE")),U,2)
IF RTIEN'>0
QUIT RESULT
+5 SET RTVALUE=+$GET(ORDIALOG(RTIEN,1))
IF RTVALUE'>0
QUIT RESULT
+6 FOR OTYPE="SOLUTION","ADDITIVE"
Begin DoDot:1
+7 SET OIIEN=+$PIECE($GET(ORDIALOG("B",OTYPE)),U,2)
IF OIIEN>0
Begin DoDot:2
+8 SET NUM=0
FOR
SET NUM=$ORDER(ORDIALOG(OIIEN,NUM))
if NUM'>0
QUIT
IF +$GET(ORDIALOG(OIIEN,NUM))>0
Begin DoDot:3
+9 SET CNT=CNT+1
SET ORDERIDS(CNT)=ORDIALOG(OIIEN,NUM)
End DoDot:3
End DoDot:2
End DoDot:1
+10 IF $DATA(ORDERIDS)=0
QUIT
+11 SET ROUTE=$$IVQOVAL^ORWDPS33(.ORDERIDS,RTVALUE)
+12 IF ROUTE=""
SET ORDIALOG(RTIEN,1)=ROUTE
+13 IF ROUTE'=""
SET RESULT=1
+14 ;K ^TMP($J,"ORWDXM3 IVRTECHK")
+15 ;D ALL^PSS51P2(RTVALUE,,,,"ORWDXM3 IVRTECHK")
+16 ;I +^TMP($J,"ORWDXM3 IVRTECHK",RTVALUE,6)'=1 S ORDIALOG(RTIEN,1)="",RESULT=0
+17 ;K ^TMP($J,"ORWDXM3 IVRTECHK")
+18 QUIT RESULT
+19 ;
ISUDQO(ORY,DLGID) ;True: is unit dose quick order
+1 SET ORY=0
+2 if '$DATA(^ORD(101.41,DLGID,0))
QUIT
+3 NEW CLODGRP,CLIVDGRP,UDGRP1,UDGRP2,DLGTYP,DLGGRP
+4 SET UDGRP1=$ORDER(^ORD(100.98,"B","UD RX",0))
+5 SET UDGRP2=$ORDER(^ORD(100.98,"B","I RX",0))
+6 SET CLODGRP=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",""))
+7 SET CLIVDGRP=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",""))
+8 SET DLGTYP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,4)
+9 IF DLGTYP="Q"
DO VERIFY^ORQOAUIC(.ORORN1,DLGID)
IF $GET(ORORN1)
Begin DoDot:1
+10 ;RTW
SET ^TMP("OR QUICK ORDER AUDIT",$JOB,"DLGID")=DLGID
End DoDot:1
+11 SET DLGGRP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,5)
+12 IF (DLGTYP="Q")
IF ((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)!(DLGGRP=CLIVDGRP))
SET ORY=1
+13 QUIT
+14 ;
SDRTCVER(ORDIALOG) ;
+1 ;Return to Clinic QO verifier
+2 IF +$$VAL^ORCD("NUMBER OF APPOINTMENTS")>1
IF +$$VAL^ORCD("INTERVAL")<1
QUIT 0
+3 IF +$$VAL^ORCD("NUMBER OF APPOINTMENTS")=1
IF +$$VAL^ORCD("INTERVAL")>0
QUIT 0
+4 QUIT 1
+5 ;
VALDS(ORDIALOG,ORVP) ;
+1 NEW ARRAY,DAYS,DOSE,DOSENUM,DRUG,DS,IDX,ISCLOZ,LASTAND,LASTDAYS,LASTIDX,MAXDS,MAXQTY,OI,QTY
+2 NEW REFILL,RESULT,SCH,STOP,TEMP,TITRATION,TOTALDAY,UNIT,VALUE,X
+3 SET RESULT=1
+4 ;build value strings for prompts in dialog, build array for conjunction and duration for complex orders
+5 SET SCH=""
SET DRUG=""
SET UNIT=""
SET DOSENUM=0
SET TITRATION=0
SET DS=0
SET OI=""
+6 FOR X="AND/THEN","DAYS SUPPLY","DOSE","DURATION","ORDERABLE ITEM","QUANTITY","REFILLS","SCHEDULE","TITRATION"
Begin DoDot:1
+7 SET TEMP=$$PTR^ORCD("OR GTX "_X)
+8 SET IDX=0
FOR
SET IDX=$ORDER(ORDIALOG(TEMP,IDX))
if IDX'>0
QUIT
Begin DoDot:2
+9 SET VALUE=$GET(ORDIALOG(TEMP,IDX))
+10 IF X="DAYS SUPPLY"
SET DS=VALUE
QUIT
+11 IF X="REFILL"
SET REFILL=VALUE
QUIT
+12 IF X="QUANTITY"
SET QTY=VALUE
QUIT
+13 IF X="DOSE"
SET UNIT=UNIT_$PIECE(VALUE,"&",3)_U
SET DRUG=DRUG_$PIECE(VALUE,"&",6)_U
SET DOSENUM=DOSENUM+1
QUIT
+14 IF X="ORDERABLE ITEM"
SET OI=VALUE
QUIT
+15 IF X="SCHEDULE"
SET SCH=SCH_VALUE_U
QUIT
+16 IF X="AND/THEN"
SET $PIECE(ARRAY(IDX),U)=VALUE
QUIT
+17 IF X="DURATION"
SET $PIECE(ARRAY(IDX),U,2)=VALUE
QUIT
+18 IF X="TITRATION"
SET TITRATION=+VALUE
QUIT
+19 IF X="REFILLS"
SET REFILL=VALUE
End DoDot:2
End DoDot:1
+20 ;detemine if order if for a Clozapine order
+21 SET ISCLOZ=$$ISCLOZ^ORALWORD(OI)
+22 IF 'ISCLOZ
Begin DoDot:1
+23 ;get MAXDS from pharmacy for non-clozapine orders
+24 IF DOSENUM>1
SET DRUG=""
+25 IF DOSENUM=1
IF DRUG'=""
SET DRUG=+DRUG
+26 DO MAXDS^ORWDPS1(.MAXDS,OI,DRUG)
+27 IF MAXDS>0
IF MAXDS<DS
SET RESULT=0
End DoDot:1
QUIT RESULT
+28 ;Clozapine checks
+29 SET DRUG=+DRUG
+30 ;Day Supply Checks
+31 DO CLZDS^ORWDPS33(.TEMP,+ORVP,DRUG,DS,OI)
+32 IF +TEMP=0
SET RESULT=0
QUIT RESULT
+33 ;build duration string for complex orders
+34 SET DUR=$SELECT($DATA(ARRAY):$$BLDDUR(.ARRAY),1:"~^")
+35 ;Quantity Checks
+36 DO DAY2QTY^ORWDPS2(.MAXQTY,DS,UNIT,SCH,DUR,+ORVP,DRUG)
+37 IF MAXQTY>0
IF MAXQTY<QTY
SET RESULT=0
+38 QUIT RESULT
+39 ;
BLDDUR(ARRAY) ;
+1 NEW CONJ,DUR,LASTCONJ,LASTDUR,LASTIDX,NOLASTDUR,RESULT,TOTALDAY,X
+2 SET LASTCONJ=""
SET LASTDUR=""
SET RESULT=""
+3 SET LASTIDX=$ORDER(ARRAY(""),-1)
+4 SET X=0
FOR
SET X=$ORDER(ARRAY(X))
if X'>0
QUIT
Begin DoDot:1
+5 SET CONJ=$PIECE(ARRAY(X),U)
SET DUR=$PIECE(ARRAY(X),U,2)
+6 IF CONJ'=""
IF LASTCONJ'=CONJ
SET LASTCONJ=CONJ
+7 IF CONJ="A"
IF DUR'=""
SET LASTDUR=+DUR
+8 IF DUR=""
IF LASTCONJ="A"
SET DUR=LASTDUR
+9 SET RESULT=RESULT_DUR_"~"_CONJ_U
End DoDot:1
+10 QUIT RESULT
