- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXM3.m
r613 r623 1 ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;05/27/2008 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215,243**;Dec 17, 1997;Build 242 3 ; 4 VALCOUNT(NAME,ORDIALOG) ; 5 N COUNT,IEN,NUM 6 S NUM=0,COUNT=0 7 S IEN=$P($G(ORDIALOG("B",NAME)),U,2) Q:IEN'>0 8 F S NUM=$O(ORDIALOG(IEN,NUM)) Q:+NUM'>0 S COUNT=COUNT+1 9 Q COUNT 10 ; 11 ISMISSFL(ORDIALOG,IVTYPE) ; 12 N ADDCNT,RESULT,STRCNT 13 S RESULT=0 14 S ADDCNT=$$VALCOUNT("ADDITIVE",.ORDIALOG) 15 S STRCNT=$$VALCOUNT("STRENGTH",.ORDIALOG) 16 I IVTYPE'="I",ADDCNT'=STRCNT S RESULT=1 17 I IVTYPE="I",ADDCNT=0 S RESULT=1 18 Q RESULT 19 ; 20 KEYVAR(DLG) ; Parse entry action for key variables & return in string 21 ; RV=CollTp^Samp^Spec^CollDt^Urg^Sched^NoComm^NoDiag^NoProv^NoRsn 22 N XCODE,RV,POS,Z 23 S XCODE=$G(^ORD(101.41,DLG,3)),RV="" 24 I '$L(XCODE) Q "" 25 S POS=$F(XCODE,"LRFZX=") I POS S $P(RV,U,1)=$$VALUE(XCODE,POS) 26 S POS=$F(XCODE,"LRFSAMP=") I POS S $P(RV,U,2)=$$VALUE(XCODE,POS) 27 S POS=$F(XCODE,"LRFSPEC=") I POS S $P(RV,U,3)=$$VALUE(XCODE,POS) 28 S POS=$F(XCODE,"LRFDATE=") I POS S $P(RV,U,4)=$$VALUE(XCODE,POS) 29 S POS=$F(XCODE,"LRFURG=") I POS S $P(RV,U,5)=$$VALUE(XCODE,POS) 30 S POS=$F(XCODE,"LRFSCH=") I POS S $P(RV,U,6)=$$VALUE(XCODE,POS) 31 S POS=$F(XCODE,"PSJNOPC=") I POS S $P(RV,U,7)=$$VALUE(XCODE,POS) 32 S POS=$F(XCODE,"GMRCNOPD=") I POS S $P(RV,U,8)=$$VALUE(XCODE,POS) 33 S POS=$F(XCODE,"GMRCNOAT=") I POS S $P(RV,U,9)=$$VALUE(XCODE,POS) 34 S POS=$F(XCODE,"GMRCREAF=") I POS S $P(RV,U,10)=$$VALUE(XCODE,POS) 35 S POS=$F(XCODE,"ORFORGET=") I POS D 36 . ; need to change this so that it is executed in SETKEYV so 37 . ; that it is executed each time menu is revisited 38 . N ORFORGET S ORFORGET=$$VALUE(XCODE,POS) 39 . I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET) 40 . E K ^TMP("ORECALL",$J) 41 Q RV 42 VALUE(STR,BEG) ; Return value of "var=" (copied from ORCONVRT) 43 N X,Y,I S X=$E(STR,BEG,999),Y="" 44 S:$E(X)="""" X=$E(X,2,999) ; strip leading " 45 F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z 46 Q $TR(Y,U,"") 47 ; 48 SETKEYV(X) ; Set the key variables based on contents of X 49 I $L($P(X,U,1)) S LRFZX=$P(X,U,1) 50 I $L($P(X,U,2)) S LRFSAMP=$P(X,U,2) 51 I $L($P(X,U,3)) S LRFSPEC=$P(X,U,3) 52 I $L($P(X,U,4)) S LRFDATE=$P(X,U,4) 53 I $L($P(X,U,5)) S LRFURG=$P(X,U,5) 54 I $L($P(X,U,6)) S LRFSCH=$P(X,U,6) 55 I $L($P(X,U,7)) S PSJNOPC=$P(X,U,7) 56 I $L($P(X,U,8)) S GMRCNOPD=$P(X,U,8) 57 I $L($P(X,U,9)) S GMRCNOAT=$P(X,U,9) 58 I $L($P(X,U,10)) S GMRCREAF=$P(X,U,10) 59 Q 60 DLGINFO(IEN,MODE) ; return information about a dialog 61 ; IEN=DlgIEN or ORIFN, MODE=0:Dlg,1:Copy,2:Change 62 ; RESULT=DlgIEN^DlgType^FormID^DGrp 63 ; If MODE="1;T",don't check "PS MEDS" for transfer order 64 ; PSMDGP=1: Unit/Dose Group 65 ; PSMDGP=2: OutPatient Group 66 N X0,DLGIEN,TYP,FID,DGRP,PSMDGP,ISXF 67 S PSMDGP=0,ISXF="" 68 S ISXF=$P(MODE,";",2) 69 S MODE=+MODE 70 S DLGIEN=IEN I MODE,(ISXF'="T") D 71 . S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5) 72 . I $P(^ORD(101.41,DLGIEN,0),U)="PS MEDS" D 73 . . N PTCAT S PTCAT=$P($G(^OR(100,+IEN,0)),U,12) 74 . . I PTCAT="I" S DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)),PSMDGP=1 75 . . I PTCAT="O" S DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)),PSMDGP=2 76 I MODE,(ISXF="T") S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5) 77 S X0=$G(^ORD(101.41,DLGIEN,0)),TYP=$P(X0,U,4),DGRP=$P(X0,U,5) 78 I MODE S DGRP=+$P($G(^OR(100,+IEN,0)),U,11) 79 ;JD NEW START 11/13/02 80 I DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) S PSMDGP=1 81 I DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)) S PSMDGP=2 82 ;JD NEW END 11/13/02 83 ; for copy or change, if the base dialog has changed, use it's info 84 I MODE,$G(ORDIALOG),(+DLGIEN'=+ORDIALOG),(PSMDGP=0) D 85 . S DLGIEN=+ORDIALOG,DGRP=$P(^ORD(101.41,+ORDIALOG,0),U,5) 86 D FORMID^ORWDXM(.FID,DLGIEN) 87 Q DLGIEN_U_TYP_U_FID_U_DGRP 88 ; 89 CHKDSBL(LST,ID,MODE) ; return message if dialog disabled 90 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change 91 ; LST=QL_REJECT + disabled message or unchanged 92 S DLGIEN=+ID I MODE S DLGIEN=+$P($G(^OR(100,+ID,0)),U,5) 93 S X0=$G(^ORD(101.41,DLGIEN,0)),X=$P(X0,U,3) 94 I '$L(X),($P(X0,U,4)="Q") D ; check default dialog 95 . S DLGIEN=+$$DEFDLG^ORWDXQ($P(X0,U,5)) 96 . S X=$P($G(^ORD(101.41,DLGIEN,0)),U,3) 97 I $L(X) D 98 . I MODE D GETTXT^ORWORR(.LST,ID) S LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -" 99 . S LST(0)="8^0",LST(.5)="Dialog Disabled: "_X 100 Q 101 CHKVACT(LST,ID,MODE,ORNP) ; return message if action not valid 102 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change 103 ; LST=QL_REJECT + invalid action message or unchanged 104 Q:'MODE ; not an action on an order 105 N X,ACT S ACT=$S(MODE=1:"RW",MODE=2:"XX",1:"") 106 D VALID^ORWDXA(.X,ID,ACT,ORNP) 107 I $L(X) D GETTXT^ORWORR(.LST,ID) D 108 . S LST(0)="8^0",LST(.5)=X,LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -" 109 Q 110 CHKCOPY(LST,ID,FLDS) ; return message if can't copy this order 111 ; ID=ORIFN;ACT FLDS=EventType in 7th piece 112 ; LST=QL_REJECT + cannot copy message or unchanged 113 I "^A^D^T^"'[(U_$E($P(FLDS,U,7))_U) Q ; not event delayed 114 N PKG S PKG=$P($G(^OR(100,+ID,0)),U,14) 115 S PKG=$$NMSP^ORCD(PKG) I PKG="OR"!(PKG="PS") Q ; xfer meds, generics 116 N ORWCAT S ORWCAT=$P($G(^OR(100,+ID,0)),U,12) 117 I ORWCAT="I",("^A^T^"[(U_$E($P(FLDS,U,7))_U)) Q ; admit, xfer inpt 118 I ORWCAT="O",$E($P(FLDS,U,7))="D" Q ; discharge outpt 119 D GETTXT^ORWORR(.LST,ID) 120 I ORWCAT="I" S LST(.5)="inpatient order to outpatient -" 121 I ORWCAT="O" S LST(.5)="outpatient order to inpatient -" 122 S:$D(LST(.5)) LST(.5)="Cannot copy the following "_LST(.5) 123 S LST(0)="8^0",LST(.7)="" 124 Q 125 BLD4CHG(LST,ID,FLDS) ; build responses for an edit 126 ; ID=ORIFN;ACT FLDS=unused right now 127 ; LST(0)=Qlvl^RespID(XOrderID)^DlgIEN^DlgType^FormID^DGrp 128 N OIDX,OI,CNT 129 S (OI,OIDX,CNT)=0 130 S:$D(^OR(100,+ID,4.5,"ID","ORDERABLE")) OIDX=$O(^OR(100,+ID,4.5,"ID","ORDERABLE",0)) 131 I $D(^OR(100,+ID,4.5,OIDX)) D 132 . F S CNT=$O(^OR(100,+ID,4.5,OIDX,CNT)) Q:'CNT D 133 . . S OI=^(CNT) D VALDOI 134 I +LST(0)=8 S LST(.5)="You can not change this order." Q 135 S LST(0)="0^X"_ID_U_$$DLGINFO(+ID,2) 136 S $P(LST(0),U,4)="X" 137 Q 138 GETIVTYP() ; 139 N RESULT,TYPEIEN 140 S RESULT="" 141 S TYPEIEN=$O(^ORD(101.41,"B","OR GTX IV TYPE","")) I TYPEIEN'>0 Q RESULT 142 S RESULT=$G(ORDIALOG(TYPEIEN,1)) 143 Q RESULT 144 ; 145 VALDOI ; Validate the Orderable Items 146 N ORQUIT,ORPS 147 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D 148 . S ORQUIT=1 149 . S LST(0)="8^0" 150 I $D(ORQUIT) Q:ORQUIT 151 S ORPS=$G(^ORD(101.43,+OI,"PS")) 152 I $P(ORPS,U,1,4)="0^0^0^0",($P(ORPS,U,7)=0) S LST(0)="8^0" 153 Q 154 VERORD() ; 155 N INFUSE,INFUID,PASSIV,SUCC,TYPE 156 S SUCC=0 157 S TYPE=$$GETIVTYP 158 I TYPE="" Q SUCC 159 S PASSIV=$$IVRTECHK 160 I PASSIV=0 Q SUCC 161 S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0)) 162 S INFUSE=$G(ORDIALOG(INFUID,1)) 163 S SUCC=$$VALINF(TYPE,INFUSE) 164 Q SUCC 165 ; 166 VALINF(TYPE,INFUSE) ; 167 N SUCC 168 S SUCC=0 169 I TYPE="I" D Q SUCC 170 .I INFUSE["INFUSE OVER" S SUCC=1 Q 171 .I $L(INFUSE)>4 Q 172 Q 1 173 ; 174 VALQO(IFN) ;Check to see if it's a good QO med 175 ;If it's an IV QO: check if infusion rate entered 176 ;If it's an UD QO: check if dosage entered 177 ;regular order treated as good QO 178 ; 179 I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1 180 N ODP,ODG,INFUID,INFUSE,DSAGEID,SUCC,PASSIV,TYPE 181 S SUCC=0 182 S ODP=+$P($G(^ORD(101.41,IFN,0)),U,7),ODG=+$P($G(^(0)),U,5) 183 S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3) 184 I ODP'["PS" Q 1 185 ;check infusion rate for IV QO 186 I ODG="IV RX"!(ODG="TPN") D 187 . S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0)) 188 . S TYPE=$$GETIVTYP 189 . I TYPE="" Q 190 . I $D(ORDIALOG(INFUID,1)) D 191 . . I TYPE="I" D Q 192 . . . S INFUSE=$G(ORDIALOG(INFUID,1)) 193 . . . I INFUSE="" Q 194 . . . I INFUSE["INFUSE OVER" S SUCC=1 Q 195 . . . I $L(INFUSE)>4 Q 196 . . . I +INFUSE>0 S INFUSE="INFUSE OVER "_INFUSE_" Minutes" 197 . . . S ORDIALOG(INFUID,1)=INFUSE,SUCC=1 198 . . S SUCC=1 199 . I '$D(ORDIALOG(INFUID,1)),TYPE="I" S SUCC=1 200 . S PASSIV=$$IVRTECHK 201 . I SUCC=0 Q 202 . I PASSIV=0 S SUCC=0 203 . I SUCC=1,$$ISMISSFL(.ORDIALOG,TYPE)=1 S SUCC=0 204 ;check dosage for UD QO 205 I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" D 206 . S DSAGEID=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) 207 . I $D(ORDIALOG(DSAGEID,1)) S SUCC=1 208 Q SUCC 209 ; 210 IVRTECHK() ; 211 N RTIEN,RTVALUE,RESULT 212 N CNT,NUM,ORDERIDS,OIIEN,OTYPE,ROUTE 213 S CNT=0,RESULT=0 214 S RTIEN=+$P($G(ORDIALOG("B","ROUTE")),U,2) I RTIEN'>0 Q RESULT 215 S RTVALUE=+$G(ORDIALOG(RTIEN,1)) I RTVALUE'>0 Q RESULT 216 F OTYPE="SOLUTION","ADDITIVE" D 217 .S OIIEN=+$P($G(ORDIALOG("B",OTYPE)),U,2) I OIIEN>0 D 218 ..S NUM=0 F S NUM=$O(ORDIALOG(OIIEN,NUM)) Q:NUM'>0 I +$G(ORDIALOG(OIIEN,NUM))>0 D 219 ...S CNT=CNT+1,ORDERIDS(CNT)=ORDIALOG(OIIEN,NUM) 220 I $D(ORDERIDS)=0 Q 221 S ROUTE=$$IVQOVAL^ORWDPS33(.ORDERIDS,RTVALUE) 222 I ROUTE="" S ORDIALOG(RTIEN,1)=ROUTE 223 I ROUTE'="" S RESULT=1 224 ;K ^TMP($J,"ORWDXM3 IVRTECHK") 225 ;D ALL^PSS51P2(RTVALUE,,,,"ORWDXM3 IVRTECHK") 226 ;I +^TMP($J,"ORWDXM3 IVRTECHK",RTVALUE,6)'=1 S ORDIALOG(RTIEN,1)="",RESULT=0 227 ;K ^TMP($J,"ORWDXM3 IVRTECHK") 228 Q RESULT 229 ; 230 ISUDQO(ORY,DLGID) ;True: is unit dose quick order 231 S ORY=0 232 Q:'$D(^ORD(101.41,DLGID,0)) 233 N CLODGRP,UDGRP1,UDGRP2,DLGTYP,DLGGRP 234 S UDGRP1=$O(^ORD(100.98,"B","UD RX",0)) 235 S UDGRP2=$O(^ORD(100.98,"B","I RX",0)) 236 S CLODGRP=$O(^ORD(100.98,"B","CLINIC ORDERS","")) 237 S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4) 238 S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5) 239 I (DLGTYP="Q"),((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)) S ORY=1 240 Q 1 ORWDXM3 ; SLC/KCM/JLI - Quick Orders ;10:42 AM 6/20/2002 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,131,132,141,185,187,190,195,215**;Dec 17, 1997 3 ; 4 KEYVAR(DLG) ; Parse entry action for key variables & return in string 5 ; RV=CollTp^Samp^Spec^CollDt^Urg^Sched^NoComm^NoDiag^NoProv^NoRsn 6 N XCODE,RV,POS,Z 7 S XCODE=$G(^ORD(101.41,DLG,3)),RV="" 8 I '$L(XCODE) Q "" 9 S POS=$F(XCODE,"LRFZX=") I POS S $P(RV,U,1)=$$VALUE(XCODE,POS) 10 S POS=$F(XCODE,"LRFSAMP=") I POS S $P(RV,U,2)=$$VALUE(XCODE,POS) 11 S POS=$F(XCODE,"LRFSPEC=") I POS S $P(RV,U,3)=$$VALUE(XCODE,POS) 12 S POS=$F(XCODE,"LRFDATE=") I POS S $P(RV,U,4)=$$VALUE(XCODE,POS) 13 S POS=$F(XCODE,"LRFURG=") I POS S $P(RV,U,5)=$$VALUE(XCODE,POS) 14 S POS=$F(XCODE,"LRFSCH=") I POS S $P(RV,U,6)=$$VALUE(XCODE,POS) 15 S POS=$F(XCODE,"PSJNOPC=") I POS S $P(RV,U,7)=$$VALUE(XCODE,POS) 16 S POS=$F(XCODE,"GMRCNOPD=") I POS S $P(RV,U,8)=$$VALUE(XCODE,POS) 17 S POS=$F(XCODE,"GMRCNOAT=") I POS S $P(RV,U,9)=$$VALUE(XCODE,POS) 18 S POS=$F(XCODE,"GMRCREAF=") I POS S $P(RV,U,10)=$$VALUE(XCODE,POS) 19 S POS=$F(XCODE,"ORFORGET=") I POS D 20 . ; need to change this so that it is executed in SETKEYV so 21 . ; that it is executed each time menu is revisited 22 . N ORFORGET S ORFORGET=$$VALUE(XCODE,POS) 23 . I ORFORGET K ^TMP("ORECALL",$J,+ORFORGET) 24 . E K ^TMP("ORECALL",$J) 25 Q RV 26 VALUE(STR,BEG) ; Return value of "var=" (copied from ORCONVRT) 27 N X,Y,I S X=$E(STR,BEG,999),Y="" 28 S:$E(X)="""" X=$E(X,2,999) ; strip leading " 29 F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z 30 Q $TR(Y,U,"") 31 ; 32 SETKEYV(X) ; Set the key variables based on contents of X 33 I $L($P(X,U,1)) S LRFZX=$P(X,U,1) 34 I $L($P(X,U,2)) S LRFSAMP=$P(X,U,2) 35 I $L($P(X,U,3)) S LRFSPEC=$P(X,U,3) 36 I $L($P(X,U,4)) S LRFDATE=$P(X,U,4) 37 I $L($P(X,U,5)) S LRFURG=$P(X,U,5) 38 I $L($P(X,U,6)) S LRFSCH=$P(X,U,6) 39 I $L($P(X,U,7)) S PSJNOPC=$P(X,U,7) 40 I $L($P(X,U,8)) S GMRCNOPD=$P(X,U,8) 41 I $L($P(X,U,9)) S GMRCNOAT=$P(X,U,9) 42 I $L($P(X,U,10)) S GMRCREAF=$P(X,U,10) 43 Q 44 DLGINFO(IEN,MODE) ; return information about a dialog 45 ; IEN=DlgIEN or ORIFN, MODE=0:Dlg,1:Copy,2:Change 46 ; RESULT=DlgIEN^DlgType^FormID^DGrp 47 ; If MODE="1;T",don't check "PS MEDS" for transfer order 48 ; PSMDGP=1: Unit/Dose Group 49 ; PSMDGP=2: OutPatient Group 50 N X0,DLGIEN,TYP,FID,DGRP,PSMDGP,ISXF 51 S PSMDGP=0,ISXF="" 52 S ISXF=$P(MODE,";",2) 53 S MODE=+MODE 54 S DLGIEN=IEN I MODE,(ISXF'="T") D 55 . S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5) 56 . I $P(^ORD(101.41,DLGIEN,0),U)="PS MEDS" D 57 . . N PTCAT S PTCAT=$P($G(^OR(100,+IEN,0)),U,12) 58 . . I PTCAT="I" S DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)),PSMDGP=1 59 . . I PTCAT="O" S DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)),PSMDGP=2 60 I MODE,(ISXF="T") S DLGIEN=+$P($G(^OR(100,+IEN,0)),U,5) 61 S X0=$G(^ORD(101.41,DLGIEN,0)),TYP=$P(X0,U,4),DGRP=$P(X0,U,5) 62 I MODE S DGRP=+$P($G(^OR(100,+IEN,0)),U,11) 63 ;JD NEW START 11/13/02 64 I DLGIEN=$O(^ORD(101.41,"B","PSJ OR PAT OE",0)) S PSMDGP=1 65 I DLGIEN=$O(^ORD(101.41,"B","PSO OERR",0)) S PSMDGP=2 66 ;JD NEW END 11/13/02 67 ; for copy or change, if the base dialog has changed, use it's info 68 I MODE,$G(ORDIALOG),(+DLGIEN'=+ORDIALOG),(PSMDGP=0) D 69 . S DLGIEN=+ORDIALOG,DGRP=$P(^ORD(101.41,+ORDIALOG,0),U,5) 70 D FORMID^ORWDXM(.FID,DLGIEN) 71 Q DLGIEN_U_TYP_U_FID_U_DGRP 72 ; 73 CHKDSBL(LST,ID,MODE) ; return message if dialog disabled 74 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change 75 ; LST=QL_REJECT + disabled message or unchanged 76 S DLGIEN=+ID I MODE S DLGIEN=+$P($G(^OR(100,+ID,0)),U,5) 77 S X0=$G(^ORD(101.41,DLGIEN,0)),X=$P(X0,U,3) 78 I '$L(X),($P(X0,U,4)="Q") D ; check default dialog 79 . S DLGIEN=+$$DEFDLG^ORWDXQ($P(X0,U,5)) 80 . S X=$P($G(^ORD(101.41,DLGIEN,0)),U,3) 81 I $L(X) D 82 . I MODE D GETTXT^ORWORR(.LST,ID) S LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -" 83 . S LST(0)="8^0",LST(.5)="Dialog Disabled: "_X 84 Q 85 CHKVACT(LST,ID,MODE,ORNP) ; return message if action not valid 86 ; ID=DlgIEN or ORIFN, MODE=0:Dialog,1:Copy,2:Change 87 ; LST=QL_REJECT + invalid action message or unchanged 88 Q:'MODE ; not an action on an order 89 N X,ACT S ACT=$S(MODE=1:"RW",MODE=2:"XX",1:"") 90 D VALID^ORWDXA(.X,ID,ACT,ORNP) 91 I $L(X) D GETTXT^ORWORR(.LST,ID) D 92 . S LST(0)="8^0",LST(.5)=X,LST(.6)="",LST(.7)="Cannot "_$S(MODE=1:"Copy",1:"Change")_" -" 93 Q 94 CHKCOPY(LST,ID,FLDS) ; return message if can't copy this order 95 ; ID=ORIFN;ACT FLDS=EventType in 7th piece 96 ; LST=QL_REJECT + cannot copy message or unchanged 97 I "^A^D^T^"'[(U_$E($P(FLDS,U,7))_U) Q ; not event delayed 98 N PKG S PKG=$P($G(^OR(100,+ID,0)),U,14) 99 S PKG=$$NMSP^ORCD(PKG) I PKG="OR"!(PKG="PS") Q ; xfer meds, generics 100 N ORWCAT S ORWCAT=$P($G(^OR(100,+ID,0)),U,12) 101 I ORWCAT="I",("^A^T^"[(U_$E($P(FLDS,U,7))_U)) Q ; admit, xfer inpt 102 I ORWCAT="O",$E($P(FLDS,U,7))="D" Q ; discharge outpt 103 D GETTXT^ORWORR(.LST,ID) 104 I ORWCAT="I" S LST(.5)="inpatient order to outpatient -" 105 I ORWCAT="O" S LST(.5)="outpatient order to inpatient -" 106 S:$D(LST(.5)) LST(.5)="Cannot copy the following "_LST(.5) 107 S LST(0)="8^0",LST(.7)="" 108 Q 109 BLD4CHG(LST,ID,FLDS) ; build responses for an edit 110 ; ID=ORIFN;ACT FLDS=unused right now 111 ; LST(0)=Qlvl^RespID(XOrderID)^DlgIEN^DlgType^FormID^DGrp 112 N OIDX,OI,CNT 113 S (OI,OIDX,CNT)=0 114 S:$D(^OR(100,+ID,4.5,"ID","ORDERABLE")) OIDX=$O(^OR(100,+ID,4.5,"ID","ORDERABLE",0)) 115 I $D(^OR(100,+ID,4.5,OIDX)) D 116 . F S CNT=$O(^OR(100,+ID,4.5,OIDX,CNT)) Q:'CNT D 117 . . S OI=^(CNT) D VALDOI 118 I +LST(0)=8 S LST(.5)="You can not change this order." Q 119 S LST(0)="0^X"_ID_U_$$DLGINFO(+ID,2) 120 S $P(LST(0),U,4)="X" 121 Q 122 VALDOI ; Validate the Orderable Items 123 N ORQUIT,ORPS 124 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT D 125 . S ORQUIT=1 126 . S LST(0)="8^0" 127 I $D(ORQUIT) Q:ORQUIT 128 S ORPS=$G(^ORD(101.43,+OI,"PS")) 129 I $P(ORPS,U,1,4)="0^0^0^0",($P(ORPS,U,7)=0) S LST(0)="8^0" 130 Q 131 VALQO(IFN) ;Check to see if it's a good QO med 132 ;If it's an IV QO: check if infusion rate entered 133 ;If it's an UD QO: check if dosage entered 134 ;regular order treated as good QO 135 ; 136 I $P($G(^ORD(101.41,IFN,0)),U,4)'="Q" Q 1 137 N ODP,ODG,INFUID,DSAGEID,SUCC 138 S SUCC=0 139 S ODP=+$P($G(^ORD(101.41,IFN,0)),U,7),ODG=+$P($G(^(0)),U,5) 140 S ODP=$$GET1^DIQ(9.4,+ODP_",",1),ODG=$P($G(^ORD(100.98,ODG,0)),U,3) 141 ;check infusion rate for IV QO 142 I ODG="IV RX"!(ODG="TPN") D 143 . S INFUID=$O(^ORD(101.41,"B","OR GTX INFUSION RATE",0)) 144 . I $D(ORDIALOG(INFUID,1)) S SUCC=1 145 ;check dosage for UD QO 146 I (ODP="PSJ")!(ODP="PSO"),ODG'="IV RX",ODG'="TPN" D 147 . S DSAGEID=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) 148 . I $D(ORDIALOG(DSAGEID,1)) S SUCC=1 149 Q SUCC 150 ISUDQO(ORY,DLGID) ;True: is unit dose quick order 151 S ORY=0 152 Q:'$D(^ORD(101.41,DLGID,0)) 153 N CLODGRP,UDGRP1,UDGRP2,DLGTYP,DLGGRP 154 S UDGRP1=$O(^ORD(100.98,"B","UD RX",0)) 155 S UDGRP2=$O(^ORD(100.98,"B","I RX",0)) 156 S CLODGRP=$O(^ORD(100.98,"B","CLINIC ORDERS","")) 157 S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4) 158 S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5) 159 I (DLGTYP="Q"),((DLGGRP=UDGRP1)!(DLGGRP=UDGRP2)!(DLGGRP=CLODGRP)) S ORY=1 160 Q
Note:
See TracChangeset
for help on using the changeset viewer.
