ORWDXM3.m

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