ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;05/27/2008 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243**;Dec 17, 1997;Build 242 ; 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,STRCNT S RESULT=0 S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG) S STRCNT=$$VALCOUNT("STRENGTH",.ORDIALOG) I IVTYPE'="I",ADDCNT'=STRCNT S RESULT=1 I IVTYPE="I",ADDCNT=0 S RESULT=1 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 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 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 ; 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 VERORD() ; N INFUSE,INFUID,PASSIV,SUCC,TYPE S SUCC=0 S TYPE=$$GETIVTYP I TYPE="" Q SUCC S PASSIV=$$IVRTECHK I PASSIV=0 Q SUCC S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0)) S INFUSE=$G(ORDIALOG(INFUID,1)) S SUCC=$$VALINF(TYPE,INFUSE) Q SUCC ; VALINF(TYPE,INFUSE) ; N SUCC S SUCC=0 I TYPE="I" D Q SUCC .I INFUSE["INFUSE OVER" S SUCC=1 Q .I $L(INFUSE)>4 Q Q 1 ; VALQO(IFN) ;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 $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1 N ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE 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 ;check infusion rate for IV QO I ODG="IV RX"!(ODG="TPN") 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 . 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 Q SUCC ; 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,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 ORDERS","")) S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4) S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5) I (DLGTYP="Q"),((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)) S ORY=1 Q