| 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
|
---|