ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;10/27/2008
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243,303,296**;Dec 17, 1997;Build 19
;
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
;
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="" S SUCC=1 Q
.I $TR(INFUSE,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["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 TYPE="I" D I SUCC=0 Q
. . N SCHIEN
. . S SCHIEN=$O(^ORD(101.41,"B","OR GTX SCHEDULE",0))
. . I $G(ORDIALOG(SCHIEN,1))="" Q
. . I $D(ORDIALOG(INFUID,1)) 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)) S SUCC=1 Q
. I TYPE="C" D I SUCC=0 Q
. . I $D(ORDIALOG(INFUID,1)) S SUCC=1
. I SUCC=0 Q
. S PASSIV=$$IVRTECHK
. 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
ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;10/27/2008
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243,303,296**;Dec 17, 1997;Build 19
+2 ;
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 ;
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 SET DLGIEN=+ID
IF MODE
SET DLGIEN=+$PIECE($GET(^OR(100,+ID,0)),U,5)
+4 SET X0=$GET(^ORD(101.41,DLGIEN,0))
SET X=$PIECE(X0,U,3)
+5 ; check default dialog
IF '$LENGTH(X)
IF ($PIECE(X0,U,4)="Q")
Begin DoDot:1
+6 SET DLGIEN=+$$DEFDLG^ORWDXQ($PIECE(X0,U,5))
+7 SET X=$PIECE($GET(^ORD(101.41,DLGIEN,0)),U,3)
End DoDot:1
+8 IF $LENGTH(X)
Begin DoDot:1
+9 IF MODE
DO GETTXT^ORWORR(.LST,ID)
SET LST(.6)=""
SET LST(.7)="Cannot "_$SELECT(MODE=1:"Copy",1:"Change")_" -"
+10 SET LST(0)="8^0"
SET LST(.5)="Dialog Disabled: "_X
End DoDot:1
+11 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 ;
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
VERORD() ;
+1 NEW INFUSE,INFUID,PASSIV,SUCC,TYPE
+2 SET SUCC=0
+3 SET TYPE=$$GETIVTYP
+4 IF TYPE=""
QUIT SUCC
+5 SET PASSIV=$$IVRTECHK
+6 IF PASSIV=0
QUIT SUCC
+7 SET INFUID=$ORDER(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
+8 SET INFUSE=$GET(ORDIALOG(INFUID,1))
+9 SET SUCC=$$VALINF(TYPE,INFUSE)
+10 QUIT SUCC
+11 ;
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) ;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 $PIECE($GET(^ORD(101.41,IFN,0)),U,4)'="Q"
QUIT 1
+6 NEW ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE
+7 SET SUCC=0
+8 SET ODP=+$PIECE($GET(^ORD(101.41,IFN,0)),U,7)
SET ODG=+$PIECE($GET(^(0)),U,5)
+9 SET ODP=$$GET1^DIQ(9.4,+ODP_",",1)
SET ODG=$PIECE($GET(^ORD(100.98,ODG,0)),U,3)
+10 IF ODP'["PS"
QUIT 1
+11 ;check infusion rate for IV QO
+12 IF ODG="IV RX"!(ODG="TPN")
Begin DoDot:1
+13 SET INFUID=$ORDER(^ORD(101.41,"B","OR GTX INFUSION RATE",0))
+14 SET TYPE=$$GETIVTYP
+15 IF TYPE=""
QUIT
+16 IF TYPE="I"
Begin DoDot:2
+17 NEW SCHIEN
+18 SET SCHIEN=$ORDER(^ORD(101.41,"B","OR GTX SCHEDULE",0))
+19 IF $GET(ORDIALOG(SCHIEN,1))=""
QUIT
+20 IF $DATA(ORDIALOG(INFUID,1))
Begin DoDot:3
+21 SET INFUSE=$GET(ORDIALOG(INFUID,1))
+22 IF INFUSE=""
QUIT
+23 IF INFUSE["INFUSE OVER"
SET SUCC=1
QUIT
+24 IF $LENGTH(INFUSE)>4
QUIT
+25 IF +INFUSE>0
SET INFUSE="INFUSE OVER "_INFUSE_" Minutes"
+26 SET ORDIALOG(INFUID,1)=INFUSE
SET SUCC=1
+27 SET SUCC=1
End DoDot:3
QUIT
+28 IF '$DATA(ORDIALOG(INFUID,1))
SET SUCC=1
QUIT
End DoDot:2
IF SUCC=0
QUIT
+29 IF TYPE="C"
Begin DoDot:2
+30 IF $DATA(ORDIALOG(INFUID,1))
SET SUCC=1
End DoDot:2
IF SUCC=0
QUIT
+31 IF SUCC=0
QUIT
+32 SET PASSIV=$$IVRTECHK
+33 IF PASSIV=0
SET SUCC=0
+34 IF SUCC=1
IF $$ISMISSFL(.ORDIALOG,TYPE)=1
SET SUCC=0
End DoDot:1
+35 ;check dosage for UD QO
+36 IF (ODP="PSJ")!(ODP="PSO")
IF ODG'="IV RX"
IF ODG'="TPN"
Begin DoDot:1
+37 SET DSAGEID=$ORDER(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0))
+38 IF $DATA(ORDIALOG(DSAGEID,1))
SET SUCC=1
End DoDot:1
+39 QUIT SUCC
+40 ;
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,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 ORDERS",""))
+7 SET DLGTYP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,4)
+8 SET DLGGRP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,5)
+9 IF (DLGTYP="Q")
IF ((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP))
SET ORY=1
+10 QUIT
