- 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 Feb 19, 2025@00:02:33 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