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

ORWDXM3.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;
  1. VALCOUNT(NAME,ORDIALOG) ;
  1. N COUNT,IEN,NUM
  1. S NUM=0,COUNT=0
  1. S IEN=$P($G(ORDIALOG("B",NAME)),U,2) Q:IEN'>0
  1. F S NUM=$O(ORDIALOG(IEN,NUM)) Q:+NUM'>0 S COUNT=COUNT+1
  1. Q COUNT
  1. ;
  1. ISMISSFL(ORDIALOG,IVTYPE) ;
  1. N ADDCNT,RESULT,SOLCNT,STRCNT
  1. S RESULT=0
  1. S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
  1. S STRCNT=$$VALCOUNT("STRENGTH",.ORDIALOG)
  1. S SOLCNT=$$VALCOUNT("SOLUTION",.ORDIALOG)
  1. I IVTYPE'="I",ADDCNT'=STRCNT S RESULT=1
  1. I IVTYPE="I" D
  1. .I ADDCNT=0,SOLCNT>0 Q
  1. .I ADDCNT=0 S RESULT=1 Q
  1. .I ADDCNT'=STRCNT S RESULT=1 Q
  1. Q RESULT
  1. ;
  1. IVADFCHK(ORDIALOG) ;
  1. ; This line tag checks to see if there are the same number of values
  1. ;for ADDITIVE and Additive Frequency. This also checks to see if
  1. ;the value assigned to ADDFREQ is one of the three possible values
  1. ;All Bags, 1 bag/day, See Comments. If See Comments it also checks
  1. ;for text in the comment section.
  1. N ADDCNT,ADDFCNT,ADDFREQ,COMMENT,FREQ,INST,RESULT
  1. S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG)
  1. S ADDFCNT=$$VALCOUNT("ADDITIVE FREQUENCY",.ORDIALOG)
  1. I ADDCNT'=ADDFCNT Q 0
  1. S ADDFREQ=$O(^ORD(101.41,"AB","OR GTX ADDITIVE FREQUENCY",""))
  1. S COMMENT=$O(^ORD(101.41,"AB","OR GTX WORD PROCESSING 1",""))
  1. I +$G(ADDFREQ)'>0 Q 0
  1. S INST=0,RESULT=1
  1. F S INST=$O(ORDIALOG(ADDFREQ,INST)) Q:INST'>0!(RESULT=0) D
  1. .S FREQ=$$ADDFRQCV^ORMBLDP1($G(ORDIALOG(ADDFREQ,INST)),"O")
  1. .I FREQ="A"!(FREQ=1) Q
  1. .I FREQ="" S RESULT=0 Q
  1. .I FREQ="S",'$L($G(ORDIALOG(COMMENT,1))) S RESULT=0 Q
  1. Q RESULT
  1. ;
  1. KEYVAR(DLG) ; Parse entry action for key variables & return in string
  1. ; RV=CollTp^Samp^Spec^CollDt^Urg^Sched^NoComm^NoDiag^NoProv^NoRsn
  1. N XCODE,RV,POS,Z
  1. S XCODE=$G(^ORD(101.41,DLG,3)),RV=""
  1. I '$L(XCODE) Q ""
  1. S POS=$F(XCODE,"LRFZX=") I POS S $P(RV,U,1)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"LRFSAMP=") I POS S $P(RV,U,2)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"LRFSPEC=") I POS S $P(RV,U,3)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"LRFDATE=") I POS S $P(RV,U,4)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"LRFURG=") I POS S $P(RV,U,5)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"LRFSCH=") I POS S $P(RV,U,6)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"PSJNOPC=") I POS S $P(RV,U,7)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"GMRCNOPD=") I POS S $P(RV,U,8)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"GMRCNOAT=") I POS S $P(RV,U,9)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"GMRCREAF=") I POS S $P(RV,U,10)=$$VALUE(XCODE,POS)
  1. S POS=$F(XCODE,"ORFORGET=") I POS D
  1. . ; need to change this so that it is executed in SETKEYV so
  1. . ; that it is executed each time menu is revisited
  1. . N ORFORGET S ORFORGET=$$VALUE(XCODE,POS)
  1. . I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET)
  1. . E K ^TMP("ORECALL",$J)
  1. Q RV
  1. VALUE(STR,BEG) ; Return value of "var=" (copied from ORCONVRT)
  1. N X,Y,I S X=$E(STR,BEG,999),Y=""
  1. S:$E(X)="""" X=$E(X,2,999) ; strip leading "
  1. F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z
  1. Q $TR(Y,U,"")
  1. ;
  1. SETKEYV(X) ; Set the key variables based on contents of X
  1. I $L($P(X,U,1)) S LRFZX=$P(X,U,1)
  1. I $L($P(X,U,2)) S LRFSAMP=$P(X,U,2)
  1. I $L($P(X,U,3)) S LRFSPEC=$P(X,U,3)
  1. I $L($P(X,U,4)) S LRFDATE=$P(X,U,4)
  1. I $L($P(X,U,5)) S LRFURG=$P(X,U,5)
  1. I $L($P(X,U,6)) S LRFSCH=$P(X,U,6)
  1. I $L($P(X,U,7)) S PSJNOPC=$P(X,U,7)
  1. I $L($P(X,U,8)) S GMRCNOPD=$P(X,U,8)
  1. I $L($P(X,U,9)) S GMRCNOAT=$P(X,U,9)
  1. I $L($P(X,U,10)) S GMRCREAF=$P(X,U,10)
  1. Q
  1. DLGINFO(IEN,MODE) ; return information about a dialog
  1. ; IEN=DlgIEN or ORIFN, MODE=0:Dlg,1:Copy,2:Change
  1. ; RESULT=DlgIEN^DlgType^FormID^DGrp
  1. ; If MODE="1;T",don't check "PS MEDS" for transfer order
  1. ; PSMDGP=1: Unit/Dose Group
  1. ; PSMDGP=2: OutPatient Group
  1. N X0,DLGIEN,TYP,FID,DGRP,PSMDGP,ISXF
  1. S PSMDGP=0,ISXF=""
  1. S ISXF=$P(MODE,";",2)
  1. S MODE=+MODE
  1. S DLGIEN=IEN I MODE,(ISXF'="T") D
  1. . S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5)
  1. . I $P(^ORD(101.41,DLGIEN,0),U)="PS MEDS" D
  1. . . N PTCAT S PTCAT=$P($G(^OR(100,+IEN,0)),U,12)
  1. . . I PTCAT="I" S DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)),PSMDGP=1
  1. . . I PTCAT="O" S DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)),PSMDGP=2
  1. I MODE,(ISXF="T") S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5)
  1. S X0=$G(^ORD(101.41,DLGIEN,0)),TYP=$P(X0,U,4),DGRP=$P(X0,U,5)
  1. I MODE S DGRP=+$P($G(^OR(100,+IEN,0)),U,11)
  1. ;JD NEW START 11/13/02
  1. I DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) S PSMDGP=1
  1. I DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)) S PSMDGP=2
  1. ;JD NEW END 11/13/02
  1. ; for copy or change, if the base dialog has changed, use it's info
  1. I MODE,$G(ORDIALOG),(+DLGIEN'=+ORDIALOG),(PSMDGP=0) D
  1. . S DLGIEN=+ORDIALOG,DGRP=$P(^ORD(101.41,+ORDIALOG,0),U,5)
  1. D FORMID^ORWDXM(.FID,DLGIEN)
  1. Q DLGIEN_U_TYP_U_FID_U_DGRP
  1. ;
  1. CHKDSBL(LST,ID,MODE) ; return message if dialog disabled
  1. ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
  1. ; LST=QL_REJECT + disabled message or unchanged
  1. N PKG
  1. S DLGIEN=+ID I MODE S DLGIEN=+$P($G(^OR(100,+ID,0)),U,5)
  1. S X0=$G(^ORD(101.41,DLGIEN,0)),X=$P(X0,U,3)
  1. I '$L(X),($P(X0,U,4)="Q") D ; check default dialog
  1. . S DLGIEN=+$$DEFDLG^ORWDXQ($P(X0,U,5))
  1. . S X=$P($G(^ORD(101.41,DLGIEN,0)),U,3)
  1. I $L(X) D
  1. . I MODE D GETTXT^ORWORR(.LST,ID) S LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -"
  1. . S LST(0)="8^0",LST(.5)="Dialog Disabled: "_X
  1. 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"
  1. Q
  1. CHKVACT(LST,ID,MODE,ORNP) ; return message if action not valid
  1. ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change
  1. ; LST=QL_REJECT + invalid action message or unchanged
  1. Q:'MODE ; not an action on an order
  1. N X,ACT S ACT=$S(MODE=1:"RW",MODE=2:"XX",1:"")
  1. D VALID^ORWDXA(.X,ID,ACT,ORNP)
  1. I $L(X) D GETTXT^ORWORR(.LST,ID) D
  1. . S LST(0)="8^0",LST(.5)=X,LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -"
  1. Q
  1. CHKCOPY(LST,ID,FLDS) ; return message if can't copy this order
  1. ; ID=ORIFN;ACT FLDS=EventType in 7th piece
  1. ; LST=QL_REJECT + cannot copy message or unchanged
  1. I "^A^D^T^"'[(U_$E($P(FLDS,U,7))_U) Q ; not event delayed
  1. N PKG S PKG=$P($G(^OR(100,+ID,0)),U,14)
  1. S PKG=$$NMSP^ORCD(PKG) I PKG="OR"!(PKG="PS") Q ; xfer meds, generics
  1. N ORWCAT S ORWCAT=$P($G(^OR(100,+ID,0)),U,12)
  1. I ORWCAT="I",("^A^T^"[(U_$E($P(FLDS,U,7))_U)) Q ; admit, xfer inpt
  1. I ORWCAT="O",$E($P(FLDS,U,7))="D" Q ; discharge outpt
  1. D GETTXT^ORWORR(.LST,ID)
  1. I ORWCAT="I" S LST(.5)="inpatient order to outpatient -"
  1. I ORWCAT="O" S LST(.5)="outpatient order to inpatient -"
  1. S:$D(LST(.5)) LST(.5)="Cannot copy the following "_LST(.5)
  1. S LST(0)="8^0",LST(.7)=""
  1. Q
  1. BLD4CHG(LST,ID,FLDS) ; build responses for an edit
  1. ; ID=ORIFN;ACT FLDS=unused right now
  1. ; LST(0)=Qlvl^RespID(XOrderID)^DlgIEN^DlgType^FormID^DGrp
  1. N OIDX,OI,CNT
  1. S (OI,OIDX,CNT)=0
  1. S:$D(^OR(100,+ID,4.5,"ID","ORDERABLE")) OIDX=$O(^OR(100,+ID,4.5,"ID","ORDERABLE",0))
  1. I $D(^OR(100,+ID,4.5,OIDX)) D
  1. . F S CNT=$O(^OR(100,+ID,4.5,OIDX,CNT)) Q:'CNT D
  1. . . S OI=^(CNT) D VALDOI
  1. I +LST(0)=8 S LST(.5)="You can not change this order." Q
  1. S LST(0)="0^X"_ID_U_$$DLGINFO(+ID,2)
  1. S $P(LST(0),U,4)="X"
  1. Q
  1. GETIVTYP() ;
  1. N RESULT,TYPEIEN
  1. S RESULT=""
  1. S TYPEIEN=$O(^ORD(101.41,"B","OR GTX IV TYPE","")) I TYPEIEN'>0 Q RESULT
  1. S RESULT=$G(ORDIALOG(TYPEIEN,1))
  1. Q RESULT
  1. ;
  1. ISTUBEQO(IFN) ;
  1. N DG,DIAL
  1. S DG=+$P($G(^ORD(101.41,IFN,0)),U,5)
  1. S DIAL=$P($G(^ORD(100.98,DG,0)),U,4)
  1. I +$G(DIAL)=0 Q 0
  1. I $P($G(^ORD(101.41,DIAL,0)),U)="FHW8" Q 1
  1. Q 0
  1. VALDOI ; Validate the Orderable Items
  1. N ORQUIT,ORPS
  1. I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D
  1. . S ORQUIT=1
  1. . S LST(0)="8^0"
  1. I $D(ORQUIT) Q:ORQUIT
  1. S ORPS=$G(^ORD(101.43,+OI,"PS"))
  1. I $P(ORPS,U,1,4)="0^0^0^0",($P(ORPS,U,7)=0) S LST(0)="8^0"
  1. Q
  1. VERDUR(ORDIALOG) ;
  1. ;check for duration value if a THEN conjunation is used
  1. N CONJ,CONVALUE,DUR,I,SUCC
  1. S SUCC=1
  1. S CONJ=$$PTR^ORCDPS1("AND/THEN")
  1. S DUR=$$PTR^ORCDPS1("DURATION")
  1. S I=0 F S I=$O(ORDIALOG(CONJ,I)) Q:I'>0!(SUCC=0) D
  1. . I $$UP^XLFSTR($E($G(ORDIALOG(CONJ,I)),1))="T" D
  1. . . I '$L($G(ORDIALOG(DUR,I))) S SUCC=0
  1. Q SUCC
  1. ;
  1. VERORD(OIEN,ORVP) ;
  1. N IFN,INFUSE,INFUID,ODG,ODP,ASSIV,SUCC,TYPE
  1. S SUCC=0,IFN=ORDIALOG
  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'["PS" Q 1
  1. I ODP="PSH" Q 1
  1. ;check infusion rate for IV QO
  1. I ODG="IV RX"!(ODG="TPN") D Q SUCC
  1. .S TYPE=$$GETIVTYP
  1. .I TYPE="" Q
  1. .S PASSIV=$$IVRTECHK
  1. .I PASSIV=0 Q
  1. .S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
  1. .S INFUSE=$G(ORDIALOG(INFUID,1))
  1. .S SUCC=$$VALINF(TYPE,INFUSE)
  1. .I SUCC=0 Q
  1. .I TYPE="C" S SUCC=$$IVADFCHK(.ORDIALOG)
  1. I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" S SUCC=$$VERDUR(.ORDIALOG) I SUCC=0 Q SUCC
  1. I ODP="PSO" S SUCC=$$VALDS(.ORDIALOG,$G(ORVP))
  1. Q SUCC
  1. ;
  1. VALINF(TYPE,INFUSE) ;
  1. N SUCC
  1. S SUCC=0
  1. I TYPE="I" D Q SUCC
  1. .I INFUSE="" S SUCC=1 Q
  1. .I $TR(INFUSE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["INFUSE OVER" S SUCC=1 Q
  1. .I $L(INFUSE)>4 Q
  1. Q 1
  1. ;
  1. 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
  1. ;If it's an UD QO: check if dosage entered
  1. ;regular order treated as good QO
  1. ;
  1. I IFN[";",($$UPCTCHK^ORWDXA(+IFN)) Q 0
  1. I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1
  1. N ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE,PRIORID,DONEID,OK
  1. S SUCC=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'["PS" Q 1
  1. I ODP="PSH" Q 1
  1. ;check for DONE urgency/priority on Outpatient QO
  1. I ODG="O RX" D Q:'OK 0
  1. . S OK=1,PRIORID=$O(^ORD(101.41,"B","OR GTX URGENCY",0)) Q:'PRIORID
  1. . S DONEID=$O(^ORD(101.42,"B","DONE",0)) Q:'DONEID
  1. . I $G(ORDIALOG(PRIORID,1))=DONEID S OK=0
  1. ;check infusion rate for IV QO
  1. I ODG="IV RX"!(ODG="TPN")!(ODG="CI RX") D
  1. . S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
  1. . S TYPE=$$GETIVTYP
  1. . I TYPE="" Q
  1. . I $D(ORDIALOG(INFUID,1)) D
  1. . . I TYPE="I" D Q
  1. . . . S INFUSE=$G(ORDIALOG(INFUID,1))
  1. . . . I INFUSE="" Q
  1. . . . I INFUSE["INFUSE OVER" S SUCC=1 Q
  1. . . . I $L(INFUSE)>4 Q
  1. . . . I +INFUSE>0 S INFUSE="INFUSE OVER "_INFUSE_" Minutes"
  1. . . . S ORDIALOG(INFUID,1)=INFUSE,SUCC=1
  1. . . S SUCC=1
  1. . ; additive frequency check/infusion rate checks for continuous orders
  1. . I TYPE="C" D I SUCC=0 Q
  1. . . I $D(ORDIALOG(INFUID,1)) S SUCC=1 I SUCC=0 Q
  1. . . S SUCC=$$IVADFCHK(.ORDIALOG)
  1. . I SUCC=0 Q
  1. . I '$D(ORDIALOG(INFUID,1)),TYPE="I" S SUCC=1
  1. . S PASSIV=$$IVRTECHK
  1. . I SUCC=0 Q
  1. . I PASSIV=0 S SUCC=0
  1. . I SUCC=1,$$ISMISSFL(.ORDIALOG,TYPE)=1 S SUCC=0
  1. ;check dosage for UD QO
  1. I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" D
  1. . S DSAGEID=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
  1. . I $D(ORDIALOG(DSAGEID,1)) S SUCC=1
  1. . I SUCC=0 Q
  1. . ;
  1. . S SUCC=$$VERDUR(.ORDIALOG) I SUCC=0 Q
  1. . I ODP="PSO",+$G(ORVP)>0 S SUCC=$$VALDS(.ORDIALOG,$G(ORVP))
  1. ;
  1. I SUCC=1,$P($G(^ORD(101.41,IFN,5)),U,8) D
  1. .N COMMID,WPCNT
  1. .S COMMID=$O(^ORD(101.41,"B","OR GTX WORD PROCESSING 1",0))
  1. .S COMMID=$O(^ORD(101.41,IFN,6,"D",COMMID,0))
  1. .I COMMID S WPCNT=0 F S WPCNT=$O(^ORD(101.41,IFN,6,COMMID,2,WPCNT)) Q:'WPCNT!('SUCC) D
  1. ..I ^ORD(101.41,IFN,6,COMMID,2,WPCNT,0)["^" S SUCC=0
  1. Q SUCC
  1. ;
  1. VALRADQO(ORDIALOG) ;
  1. N ORID,ORVALUE
  1. ;check urgency
  1. S ORID=$P($G(ORDIALOG("B","URGENCY")),U,2)
  1. I ORID'>0 Q 0
  1. S ORVALUE=$G(ORDIALOG(ORID,1))
  1. I ORVALUE'>0 Q 0
  1. I '$$RADURG^ORWDRA32(ORVALUE) Q 0
  1. Q 1
  1. ;
  1. ISRAD(ORIFN) ;
  1. N ORPKG
  1. I 'ORWMODE S ORPKG=$P($G(^ORD(101.41,+ORIFN,0)),U,7)
  1. E S ORPKG=$P($G(^OR(100,+ORIFN,0)),U,14)
  1. Q $$NMSP^ORCD(ORPKG)="RA"
  1. ;
  1. IVRTECHK() ;
  1. N RTIEN,RTVALUE,RESULT
  1. N CNT,NUM,ORDERIDS,OIIEN,OTYPE,ROUTE
  1. S CNT=0,RESULT=0
  1. S RTIEN=+$P($G(ORDIALOG("B","ROUTE")),U,2) I RTIEN'>0 Q RESULT
  1. S RTVALUE=+$G(ORDIALOG(RTIEN,1)) I RTVALUE'>0 Q RESULT
  1. F OTYPE="SOLUTION","ADDITIVE" D
  1. .S OIIEN=+$P($G(ORDIALOG("B",OTYPE)),U,2) I OIIEN>0 D
  1. ..S NUM=0 F S NUM=$O(ORDIALOG(OIIEN,NUM)) Q:NUM'>0 I +$G(ORDIALOG(OIIEN,NUM))>0 D
  1. ...S CNT=CNT+1,ORDERIDS(CNT)=ORDIALOG(OIIEN,NUM)
  1. I $D(ORDERIDS)=0 Q
  1. S ROUTE=$$IVQOVAL^ORWDPS33(.ORDERIDS,RTVALUE)
  1. I ROUTE="" S ORDIALOG(RTIEN,1)=ROUTE
  1. I ROUTE'="" S RESULT=1
  1. ;K ^TMP($J,"ORWDXM3 IVRTECHK")
  1. ;D ALL^PSS51P2(RTVALUE,,,,"ORWDXM3 IVRTECHK")
  1. ;I +^TMP($J,"ORWDXM3 IVRTECHK",RTVALUE,6)'=1 S ORDIALOG(RTIEN,1)="",RESULT=0
  1. ;K ^TMP($J,"ORWDXM3 IVRTECHK")
  1. Q RESULT
  1. ;
  1. ISUDQO(ORY,DLGID) ;True: is unit dose quick order
  1. S ORY=0
  1. Q:'$D(^ORD(101.41,DLGID,0))
  1. N CLODGRP,CLIVDGRP,UDGRP1,UDGRP2,DLGTYP,DLGGRP
  1. S UDGRP1=$O(^ORD(100.98,"B","UD RX",0))
  1. S UDGRP2=$O(^ORD(100.98,"B","I RX",0))
  1. S CLODGRP=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",""))
  1. S CLIVDGRP=$O(^ORD(100.98,"B","CLINIC INFUSIONS",""))
  1. S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4)
  1. I DLGTYP="Q" D VERIFY^ORQOAUIC(.ORORN1,DLGID) I $G(ORORN1) D
  1. . S ^TMP("OR QUICK ORDER AUDIT",$J,"DLGID")=DLGID ;RTW
  1. S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5)
  1. I (DLGTYP="Q"),((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)!(DLGGRP=CLIVDGRP)) S ORY=1
  1. Q
  1. ;
  1. SDRTCVER(ORDIALOG) ;
  1. ;Return to Clinic QO verifier
  1. I +$$VAL^ORCD("NUMBER OF APPOINTMENTS")>1,+$$VAL^ORCD("INTERVAL")<1 Q 0
  1. I +$$VAL^ORCD("NUMBER OF APPOINTMENTS")=1,+$$VAL^ORCD("INTERVAL")>0 Q 0
  1. Q 1
  1. ;
  1. VALDS(ORDIALOG,ORVP) ;
  1. N ARRAY,DAYS,DOSE,DOSENUM,DRUG,DS,IDX,ISCLOZ,LASTAND,LASTDAYS,LASTIDX,MAXDS,MAXQTY,OI,QTY
  1. N REFILL,RESULT,SCH,STOP,TEMP,TITRATION,TOTALDAY,UNIT,VALUE,X
  1. S RESULT=1
  1. ;build value strings for prompts in dialog, build array for conjunction and duration for complex orders
  1. S SCH="",DRUG="",UNIT="",DOSENUM=0,TITRATION=0,DS=0,OI=""
  1. F X="AND/THEN","DAYS SUPPLY","DOSE","DURATION","ORDERABLE ITEM","QUANTITY","REFILLS","SCHEDULE","TITRATION" D
  1. .S TEMP=$$PTR^ORCD("OR GTX "_X)
  1. .S IDX=0 F S IDX=$O(ORDIALOG(TEMP,IDX)) Q:IDX'>0 D
  1. ..S VALUE=$G(ORDIALOG(TEMP,IDX))
  1. ..I X="DAYS SUPPLY" S DS=VALUE Q
  1. ..I X="REFILL" S REFILL=VALUE Q
  1. ..I X="QUANTITY" S QTY=VALUE Q
  1. ..I X="DOSE" S UNIT=UNIT_$P(VALUE,"&",3)_U,DRUG=DRUG_$P(VALUE,"&",6)_U,DOSENUM=DOSENUM+1 Q
  1. ..I X="ORDERABLE ITEM" S OI=VALUE Q
  1. ..I X="SCHEDULE" S SCH=SCH_VALUE_U Q
  1. ..I X="AND/THEN" S $P(ARRAY(IDX),U)=VALUE Q
  1. ..I X="DURATION" S $P(ARRAY(IDX),U,2)=VALUE Q
  1. ..I X="TITRATION" S TITRATION=+VALUE Q
  1. ..I X="REFILLS" S REFILL=VALUE
  1. ;detemine if order if for a Clozapine order
  1. S ISCLOZ=$$ISCLOZ^ORALWORD(OI)
  1. I 'ISCLOZ D Q RESULT
  1. .;get MAXDS from pharmacy for non-clozapine orders
  1. .I DOSENUM>1 S DRUG=""
  1. .I DOSENUM=1,DRUG'="" S DRUG=+DRUG
  1. .D MAXDS^ORWDPS1(.MAXDS,OI,DRUG)
  1. .I MAXDS>0,MAXDS<DS S RESULT=0
  1. ;Clozapine checks
  1. S DRUG=+DRUG
  1. ;Day Supply Checks
  1. D CLZDS^ORWDPS33(.TEMP,+ORVP,DRUG,DS,OI)
  1. I +TEMP=0 S RESULT=0 Q RESULT
  1. ;build duration string for complex orders
  1. S DUR=$S($D(ARRAY):$$BLDDUR(.ARRAY),1:"~^")
  1. ;Quantity Checks
  1. D DAY2QTY^ORWDPS2(.MAXQTY,DS,UNIT,SCH,DUR,+ORVP,DRUG)
  1. I MAXQTY>0,MAXQTY<QTY S RESULT=0
  1. Q RESULT
  1. ;
  1. BLDDUR(ARRAY) ;
  1. N CONJ,DUR,LASTCONJ,LASTDUR,LASTIDX,NOLASTDUR,RESULT,TOTALDAY,X
  1. S LASTCONJ="",LASTDUR="",RESULT=""
  1. S LASTIDX=$O(ARRAY(""),-1)
  1. S X=0 F S X=$O(ARRAY(X)) Q:X'>0 D
  1. .S CONJ=$P(ARRAY(X),U),DUR=$P(ARRAY(X),U,2)
  1. .I CONJ'="",LASTCONJ'=CONJ S LASTCONJ=CONJ
  1. .I CONJ="A",DUR'="" S LASTDUR=+DUR
  1. .I DUR="",LASTCONJ="A" S DUR=LASTDUR
  1. .S RESULT=RESULT_DUR_"~"_CONJ_U
  1. Q RESULT