- 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/ORWDX.m
r613 r623 1 ORWDX ; SLC/KCM/REV/JLI - Order dialog utilities ;11/28/2006 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,132,141,164,178,187,190,195,215,246,243**;Dec 17, 1997;Build 242 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ORDITM(Y,FROM,DIR,XREF) ; Subset of orderable items 6 ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name 7 N I,IEN,CNT,X,DTXT,CURTM,DEFROUTE 8 S DEFROUTE="" 9 S I=0,CNT=44,CURTM=$$NOW^XLFDT 10 F Q:I'<CNT S FROM=$O(^ORD(101.43,XREF,FROM),DIR) Q:FROM="" D 11 . S IEN="" F S IEN=$O(^ORD(101.43,XREF,FROM,IEN),DIR) Q:'IEN D 12 . . S X=^ORD(101.43,XREF,FROM,IEN) 13 . . I +$P(X,U,3),$P(X,U,3)<CURTM Q 14 . . Q:$P(X,U,5) S I=I+1 15 . . I XREF="S.IVA RX"!(XREF="S.IVB RX") S DEFROUTE=$P($G(^ORD(101.43,IEN,"PS")),U,8) 16 . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)_U_DEFROUTE 17 . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)_U_DEFROUTE 18 Q 19 ODITMBC(Y,XREF,ODLST) ; 20 N CNT,NM,XRF 21 S CNT=0,NM=0,XRF=XREF 22 F S CNT=$O(ODLST(CNT)) Q:'CNT D FNDINFO(.Y,ODLST(CNT)) 23 Q 24 FNDINFO(Y,ODIEN) ; 25 D FNDINFO^ORWDX1(.Y,.ODIEN) 26 Q 27 DLGDEF(LST,DLG) ; Format mapping for a dlg 28 D DLGDEF^ORWDX1(.LST,.DLG) 29 Q 30 DLGQUIK(LST,QO) ;(NOT USED) 31 D LOADRSP(.LST,QO) 32 Q 33 LOADRSP(LST,RSPID,TRANS) ; Load responses from 101.41 or 100 34 ; RSPID: C123456;1-3243 = cached copy, 134-3234 = cached quick 35 ; X123456;1 = change order, 134 = quick dialog 36 N I,J,DLG,INST,ID,VAL,ILST,ROOT,ORLOC S ROOT="" 37 I RSPID["-" S ROOT="^TMP(""ORWDXMQ"",$J,"""_RSPID_""")" G XROOT^ORWDX2 38 I $E(RSPID)="X" S ROOT="^OR(100,"_+$P(RSPID,"X",2)_",4.5)" G XROOT^ORWDX2 39 I +RSPID=RSPID S ROOT="^ORD(101.41,"_+RSPID_",6)" G XROOT^ORWDX2 40 Q:ROOT="" 41 G XROOT^ORWDX2 42 SAVE(REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,ORDIALOG,ORDEA,ORAPPT,ORSRC,OREVTDF) ; 43 ; ORVP=DFN, ORNP=Provider, ORL=Location, DLG=Order Dialog, 44 ; ORDG=Display Group, ORIT=Quick Order Dialog, ORAPPT=Appointment 45 N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORLEAD,ORTRAIL,ORPKG,ORWP94,ORCATFN,OREVTYPE,ONPASS 46 N XCNT,XCOMM,XDONE,XX ;SBR 47 S (XCOMM,XCNT)="" ;SBR 48 I $G(ORIFN)'="" D ;SBR problem only occurs on change or renew orders 49 . S XCNT=$O(^OR(100,+ORIFN,4.5,"ID","COMMENT",XCNT)) ;SBR 50 . I XCNT'="" S XCOMM=$P($G(^OR(100,+ORIFN,4.5,XCNT,0)),"^",2) ;SBR 51 . I XCOMM'="" S XDONE=0,XX="" F S XX=$O(ORDIALOG("WP",XCOMM,1,XX)) Q:XX="" D ;SBR 52 . . I ORDIALOG("WP",XCOMM,1,XX,0)'="" S XDONE=1 Q ;SBR 53 . I XCOMM'="",'$G(XDONE),$D(ORDIALOG("WP",XCOMM)) K ORDIALOG("WP",XCOMM) ;SBR 54 S ORCATFN="" I $L($P(DLG,U,2)) S ORCATFN=$P(DLG,U,2),DLG=$P(DLG,U,1) 55 ;Remove treating facility if inpatient and IMO order 26.42 56 I $G(^DPT(ORVP,.1))'="",$P($G(^ORD(100.98,ORDG,0)),U)="CLINIC ORDERS" K ORDIALOG("ORTS") 57 I $G(ORDIALOG("ORTS")) S ORTS=ORDIALOG("ORTS") K ORDIALOG("ORTS") 58 I $G(ORDIALOG("ORSLOG")) S ORLOG=ORDIALOG("ORSLOG") K ORDIALOG("ORSLOG") 59 I $D(ORDIALOG("OREVENT")) S OREVENT=ORDIALOG("OREVENT") K ORDIALOG("OREVENT") 60 ;===================================================== 61 ; Changed for v26.27 (RV) 62 S ORCAT=$$INPT^ORCD,ORCAT=$S(ORCAT=1:"I",1:"O") 63 ;I $L($G(OREVENT)) D 64 ;. S ONPASS=0 65 ;. S OREVTYPE=$$TYPE^OREVNTX(OREVENT) 66 ;. I OREVTYPE="T" D ISPASS^OREVNTX1(.ONPASS,+OREVENT,"T") 67 ;. S ORCAT=$S(OREVTYPE="A":"I",OREVTYPE="T":"I",ONPASS=1:"O",1:"O") 68 ;E S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 69 ;===================================================== 70 I DLG="PS MEDS" S ORWP94=1 D 71 . I ORIT=$O(^ORD(101.41,"AB","PSO SUPPLY",0)) S DLG="PSO SUPPLY" 72 . I ORIT=$O(^ORD(101.41,"AB","PSO OERR",0)) S DLG="PSO OERR" 73 . I ORIT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) S DLG="PSJ OR PAT OE" 74 I DLG="PSO OERR" S ORCAT="O" I $G(OREVENT("EFFECTIVE")) D 75 . S ORDIALOG($O(^ORD(101.41,"B","OR GTX START DATE"_$S($G(ORWP94):"/TIME",1:""),0)),1)=OREVENT("EFFECTIVE") 76 I DLG="PSJ OR PAT OE" S ORCAT="I" 77 S:DLG="FHW1" ORCAT="I" S:DLG?1"FHW "2.7U1" MEAL" ORCAT="O" 78 S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2) 79 I ORDG=$O(^ORD(100.98,"B","LAB",0)) D ;use section 80 . N OI,SUB S OI=+$G(ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)) 81 . S SUB=$P($G(^ORD(101.43,OI,"LR")),U,6),ORDG=$$DGRP^ORMLR(SUB) 82 K:'ORDG ORDG K:'ORIT ORIT ; Dgrp & Quick must be non-zero 83 M ORCHECK=ORDIALOG("ORCHECK") K ORDIALOG("ORCHECK") 84 S ORDIALOG=$O(^ORD(101.41,"AB",DLG,0)) 85 I 'ORDIALOG S ORDIALOG=$O(^ORD(101.41,"B",DLG,0)) 86 I $D(ORDIALOG("ORLEAD")) S ORLEAD=ORDIALOG("ORLEAD") 87 I $D(ORDIALOG("ORTRAIL")) S ORTRAIL=ORDIALOG("ORTRAIL") 88 D GETDLG1^ORCD(ORDIALOG) 89 I $L(ORCATFN) S ORCAT=ORCATFN 90 I $G(ORWP94) D 91 . N SIGPRMT S SIGPRMT=$O(^ORD(101.41,"B","OR GTX SIG",0)) 92 . N INSPRMT S INSPRMT=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) 93 . I $L($G(ORDIALOG(SIGPRMT,1))) S ORDIALOG(INSPRMT,"FORMAT")="@" 94 . I ORCAT="O" S ORPKG=$O(^DIC(9.4,"C","PSO",0)) 95 . I ORCAT="I" S ORPKG=$O(^DIC(9.4,"C","PSJ",0)) 96 S ORSRC=$G(ORSRC) 97 D DELPI^ORWDX1 ;delete empty PI 98 I $G(ORIFN)="" D ; new order 99 . D EN^ORCSAVE 100 . S REC="" I ORIFN D GETBYIFN^ORWORR(.REC,ORIFN) 101 . I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^TMP("ORECALL",$J,ORDIALOG)=ORDIALOG 102 E D 103 . N OR0 104 . S OR0=$G(^OR(100,+ORIFN,0)),ORSTS=$P($G(^(3)),U,3),ORDG=$P(OR0,U,11) 105 . I $L($P(OR0,U,17)),ORSTS=10 S OREVENT=$P(OR0,U,17),OREVENT("TS")=$P(OR0,U,13) 106 . D XX^ORCSAVE ; edit order 107 . S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN) 108 Q 109 SENDED(ORWLST,ORIENS,TS,LOC) ; Release EDOs to svc 110 N OK,ORVP,ORWERR,ORSIGST,ORDA,ORNATURE,ORIX,X,PTEVT,ORIFN,J,EVENT,LOCK 111 S ORWERR="",ORIX=0,LOC=LOC_";SC(" 112 F S ORIX=$O(ORIENS(ORIX)) Q:'ORIX D 113 . S ORIFN=ORIENS(ORIX) 114 . S PTEVT=$P(^OR(100,+ORIFN,0),U,17) I PTEVT S LOCK=$$LCKEVT^ORX2(PTEVT) S:LOCK EVENT(PTEVT)="" I 'LOCK S ORWERR="1^delayed event is locked - another user is processing orders for this event" ;195 115 . S ORDA=$P(ORIFN,";",2) S:'ORDA ORDA=1 116 . S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2) 117 . I $D(^OR(100,+ORIFN,8,ORDA,0)) D 118 .. S ORSIGST=$P($G(^(0)),U,4) 119 .. S ORNATURE=$P($G(^(0)),U,12) 120 . S:$G(LOC) $P(^OR(100,+ORIFN,0),U,10)=LOC ;set location 121 . S:$G(TS) $P(^OR(100,+ORIFN,0),U,13)=TS ;set specialty 122 . S OK=$$LOCK1^ORX2(ORIFN) I 'OK S ORWERR="1^"_$P(OK,U,2) 123 . I OK,$G(LOCK) D EN2^ORCSEND(ORIENS(ORIX),ORSIGST,ORNATURE,.ORWERR),UNLK1^ORX2(ORIENS(ORIX)) ;add ,LOCK to if statement for 195 124 . S ORWLST(ORIX)=ORIENS(ORIX) 125 . I $L(ORWERR) S ORWLST(ORIX)=ORWLST(ORIX)_"^E^"_ORWERR Q 126 . E D 127 .. S PTEVT=$P($G(^OR(100,+ORIENS(ORIX),0)),U,17) 128 .. D:$$TYPE^OREVNTX(PTEVT)="M" SAVE^ORMEVNT1(ORIENS(ORIX),PTEVT,2) 129 . S X="RS" 130 . S $P(ORWLST(ORIX),U,2)=X 131 S J=0 F S J=$O(EVENT(J)) Q:'+J D UNLEVT^ORX2(J) ;195 132 Q 133 SEND(ORWLST,DFN,ORNP,ORL,ES,ORWREC) ; Sign 134 ; DFN=Patient, ORNP=Provider, ORL=Location, ES=Encrypted ES code 135 ; ORWREC(n)=ORIFN;Action^Signature Sts^Release Sts^Nature of Order 136 SEND1 N ORVP,ORWI,ORWERR,ORWREL,ORWSIG,ORWNATR,ORDERID,ORBEF,ORLR,ORLAB,X,I 137 S ORVP=DFN_";DPT(",ORL=ORL_";SC(",ORL(2)=ORL,ORWLST=0 138 F I="LR","VBEC" S X=+$O(^DIC(9.4,"C",I,0)) S:X ORLR(X)=1 139 S ORWI=0 F S ORWI=$O(ORWREC(ORWI)) Q:'ORWI D 140 . S X=ORWREC(ORWI),ORWERR="" 141 . S ORDERID=$P(X,U),ORWSIG=$P(X,U,2),ORWREL=$P(X,U,3),ORWNATR=$P(X,U,4) 142 . S ORBEF=0 143 . I '$D(^OR(100,+ORDERID,0)) Q 144 . I $D(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0)) S ORBEF=$P(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0),U,15) 145 . S:$D(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0)) ORWNATR=$S($P(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0),"^",4)=3:"",1:ORWNATR) 146 . S ORWERR=$$CHKACT^ORWDXR(ORDERID,ORWSIG,ORWREL,ORWNATR) 147 . I $L(ORWERR) S ORWERR="1^"_ORWERR 148 . I '$L(ORWERR) D 149 .. I $G(ORLR(+$P(^OR(100,+ORDERID,0),U,14))),'$G(ORLAB) D ; lab batch start 150 ... I $L($T(BHS^ORMBLD)) D BHS^ORMBLD(ORVP) S ORLAB=1 151 .. N OK S OK=$$LOCK1^ORX2(ORDERID) I 'OK S ORWERR="1^"_$P(OK,U,2) 152 .. I OK D EN^ORCSEND(ORDERID,"",ORWSIG,ORWREL,ORWNATR,"",.ORWERR),UNLK1^ORX2(ORDERID) 153 . S ORWLST(ORWI)=ORDERID,X="" 154 . I $L(ORWERR) S ORWLST(ORWI)=ORWLST(ORWI)_"^E^"_ORWERR Q 155 . I ORWREL,((ORBEF=10)!(ORBEF=11)),($P(^OR(100,+ORDERID,3),U,3)'=10) S X="R" 156 . I ORWSIG'=2 S X=X_"S" 157 . S $P(ORWLST(ORWI),U,2)=X 158 I $G(ORLAB) D BTS^ORMBLD(ORVP) 159 Q 160 DLGID(VAL,ORIFN) ; return dlg IEN for order 161 S VAL=$P(^OR(100,+ORIFN,0),U,5) 162 S VAL=$S($P(VAL,";",2)="ORD(101.41,":+VAL,1:0) 163 Q 164 FORMID(VAL,ORIFN) ; Base dlg FormID for an order 165 N DLG 166 S VAL=0,DLG=$P(^OR(100,+ORIFN,0),U,5) 167 Q:$P(DLG,";",2)'="ORD(101.41," 168 D FORMID^ORWDXM(.VAL,+DLG) 169 Q 170 AGAIN(VAL,DLG) ; return true to keep dlg for another order 171 S VAL=''$P($G(^ORD(101.41,DLG,0)),U,9) 172 Q 173 DGRP(VAL,DLG) ; Display grp pointer for a dlg 174 S DLG=$S($E(DLG)="`":+$P(DLG,"`",2),1:$O(^ORD(101.41,"AB",DLG,0))) ;kcm 175 S VAL=$P($G(^ORD(101.41,DLG,0)),U,5) 176 Q 177 DGNM(VAL,NM) ; Display grp pointer for name 178 S VAL=$O(^ORD(100.98,"B",NM,0)) 179 Q 180 WRLST(LST,LOC) ; List of dlgs for writing orders 181 G WRLST1^ORWDX1 182 MSG(LST,IEN) ; Msg text for orderable item 183 N I 184 S I=0 F S I=$O(^ORD(101.43,IEN,8,I)) Q:I'>0 S LST(I)=^(I,0) 185 Q 186 DISMSG(VAL,IEN) ; Disabled mge for ordering dlg 187 S VAL=$P($G(^ORD(101.41,+IEN,0)),U,3) 188 Q 189 LOCK(OK,DFN) ; Attempt to lock pt for ordering 190 S OK=$$LOCK^ORX2(DFN) 191 Q 192 UNLOCK(OK,DFN) ; Unlock pt for ordering 193 D UNLOCK^ORX2(DFN) S OK=1 194 Q 195 LOCKORD(OK,ORIFN) ; Attempt to lock order 196 S OK=$$LOCK1^ORX2(ORIFN) 197 Q 198 UNLKORD(OK,ORIFN) ; Unlock order 199 D UNLK1^ORX2(ORIFN) S OK=1 200 Q 1 ORWDX ; SLC/KCM/REV/JLI - Order dailog utilities ;4/21/07 19:18 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,125,131,132,141,164,178,187,190,195,215,269**;Dec 17, 1997;Build 28 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 NXT() ; -- Gets index in array 12 S ILST=ILST+1 13 Q ILST 14 ; 15 ORDITM(Y,FROM,DIR,XREF) ; Subset of orderable items 16 ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name 17 N I,IEN,CNT,X,DTXT,CURTM 18 S I=0,CNT=44,CURTM=$$NOW^XLFDT 19 F Q:I'<CNT S FROM=$O(^ORD(101.43,XREF,FROM),DIR) Q:FROM="" D 20 . S IEN="" F S IEN=$O(^ORD(101.43,XREF,FROM,IEN),DIR) Q:'IEN D 21 . . S X=^ORD(101.43,XREF,FROM,IEN) 22 . . I +$P(X,U,3),$P(X,U,3)<CURTM Q 23 . . Q:$P(X,U,5) S I=I+1 24 . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2) 25 . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4) 26 Q 27 ODITMBC(Y,XREF,ODLST) ; 28 N CNT,NM,XRF 29 S CNT=0,NM=0,XRF=XREF 30 F S CNT=$O(ODLST(CNT)) Q:'CNT D FNDINFO(.Y,ODLST(CNT)) 31 Q 32 FNDINFO(Y,ODIEN) ; 33 D FNDINFO^ORWDX1(.Y,.ODIEN) 34 Q 35 DLGDEF(LST,DLG) ; Format mapping for a dlg 36 D DLGDEF^ORWDX1(.LST,.DLG) 37 Q 38 DLGQUIK(LST,QO) ;(NOT USED) 39 D LOADRSP(.LST,QO) 40 Q 41 LOADRSP(LST,RSPID) ; Load responses from 101.41 or 100 42 ; RSPID: C123456;1-3243 = cached copy, 134-3234 = cached quick 43 ; X123456;1 = change order, 134 = quick dialog 44 N I,J,DLG,INST,ID,VAL,ILST,ROOT S ROOT="" 45 I RSPID["-" S ROOT="^TMP(""ORWDXMQ"",$J,"""_RSPID_""")" G XROOT 46 I $E(RSPID)="X" S ROOT="^OR(100,"_+$P(RSPID,"X",2)_",4.5)" G XROOT 47 I +RSPID=RSPID S ROOT="^ORD(101.41,"_+RSPID_",6)" G XROOT 48 Q:ROOT="" 49 XROOT S (ILST,I)=0 F S I=$O(@ROOT@(I)) Q:I'>0 D 50 . S DLG=$P(@ROOT@(I,0),U,2),INST=$P(^(0),U,3) 51 . S ID=$P($G(^ORD(101.41,DLG,1)),U,3) 52 . I '$L(ID) S ID="ID"_DLG 53 . S VAL=$G(@ROOT@(I,1)) 54 . I $P($G(^ORD(101.41,DLG,0)),U)="OR GTX ADDITIVE" S ID="ADDITIVE" 55 . I $E(RSPID)="C",(ID="START"),VAL Q ; skip literal start time on copy 56 . S LST($$NXT)="~"_DLG_U_INST_U_ID 57 . I $L(VAL) D 58 .. S LST($$NXT)="i"_VAL,LST($$NXT)="e"_$$EXTVAL(VAL,DLG) 59 . I $D(@ROOT@(I,2))>1 D 60 .. S J=0 F S J=$O(@ROOT@(I,2,J)) Q:J'>0 D 61 ... S LST($$NXT)="t"_$G(@ROOT@(I,2,J,0)) 62 I $E(ROOT,1,4)="^TMP" K ^TMP("ORWDXMQ",$J) 63 Q 64 SAVE(REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,ORDIALOG,ORDEA,ORAPPT,ORSRC,OREVTDF) ; 65 ; ORVP=DFN, ORNP=Provider, ORL=Location, DLG=Order Dialog, 66 ; ORDG=Display Group, ORIT=Quick Order Dialog, ORAPPT=Appointment 67 N ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORNEW,ORCHECK,ORLOG,ORLEAD,ORTRAIL,ORPKG,ORWP94,ORCATFN,OREVTYPE,ONPASS 68 ; JD FIX FOR WASHINGTON DC 69 ;I '$L(ORSRC)!($G(ORSRC)=" ")!($G(ORSRC)=0) S ORSRC=$P(ORVP,U,2) 70 ;S ORVP=$P(ORVP,U) 71 ; END FIX JD 72 S ORCATFN="" 73 I $L($P(DLG,U,2)) S ORCATFN=$P(DLG,U,2),DLG=$P(DLG,U,1) 74 ;Remove treating facility if inpatient and IMO order 26.42 75 I $G(^DPT(ORVP,.1))'="",$P($G(^ORD(100.98,ORDG,0)),U)="CLINIC ORDERS" K ORDIALOG("ORTS") 76 I $G(ORDIALOG("ORTS")) S ORTS=ORDIALOG("ORTS") K ORDIALOG("ORTS") 77 I $G(ORDIALOG("ORSLOG")) S ORLOG=ORDIALOG("ORSLOG") K ORDIALOG("ORSLOG") 78 I $D(ORDIALOG("OREVENT")) S OREVENT=ORDIALOG("OREVENT") K ORDIALOG("OREVENT") 79 ;======= 80 ; Changed for v26.27 (RV) 81 S ORCAT=$$INPT^ORCD,ORCAT=$S(ORCAT=1:"I",1:"O") 82 ;I $L($G(OREVENT)) D 83 ;. S ONPASS=0 84 ;. S OREVTYPE=$$TYPE^OREVNTX(OREVENT) 85 ;. I OREVTYPE="T" D ISPASS^OREVNTX1(.ONPASS,+OREVENT,"T") 86 ;. S ORCAT=$S(OREVTYPE="A":"I",OREVTYPE="T":"I",ONPASS=1:"O",1:"O") 87 ;E S ORCAT=$S($L($P($G(^DPT(+ORVP,.1)),U)):"I",1:"O") 88 ;======= 89 I DLG="PS MEDS" S ORWP94=1 D 90 . I ORIT=$O(^ORD(101.41,"AB","PSO SUPPLY",0)) S DLG="PSO SUPPLY" 91 . I ORIT=$O(^ORD(101.41,"AB","PSO OERR",0)) S DLG="PSO OERR" 92 . I ORIT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) S DLG="PSJ OR PAT OE" 93 I DLG="PSO OERR" S ORCAT="O" I $G(OREVENT("EFFECTIVE")) D 94 . S ORDIALOG($O(^ORD(101.41,"B","OR GTX START DATE"_$S($G(ORWP94):"/TIME",1:""),0)),1)=OREVENT("EFFECTIVE") 95 I DLG="PSJ OR PAT OE" S ORCAT="I" 96 S:DLG="FHW1" ORCAT="I" S:DLG?1"FHW "2.7U1" MEAL" ORCAT="O" 97 S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2) 98 K:'ORDG ORDG K:'ORIT ORIT ; Dgrp & Quick must be non-zero 99 M ORCHECK=ORDIALOG("ORCHECK") K ORDIALOG("ORCHECK") 100 S ORDIALOG=$O(^ORD(101.41,"AB",DLG,0)) 101 I 'ORDIALOG S ORDIALOG=$O(^ORD(101.41,"B",DLG,0)) 102 I $D(ORDIALOG("ORLEAD")) S ORLEAD=ORDIALOG("ORLEAD") 103 I $D(ORDIALOG("ORTRAIL")) S ORTRAIL=ORDIALOG("ORTRAIL") 104 D GETDLG1^ORCD(ORDIALOG) 105 I $L(ORCATFN) S ORCAT=ORCATFN 106 I $G(ORWP94) D 107 . N SIGPRMT S SIGPRMT=$O(^ORD(101.41,"B","OR GTX SIG",0)) 108 . N INSPRMT S INSPRMT=$O(^ORD(101.41,"B","OR GTX INSTRUCTIONS",0)) 109 . I $L($G(ORDIALOG(SIGPRMT,1))) S ORDIALOG(INSPRMT,"FORMAT")="@" 110 . I ORCAT="O" S ORPKG=$O(^DIC(9.4,"C","PSO",0)) 111 . I ORCAT="I" S ORPKG=$O(^DIC(9.4,"C","PSJ",0)) 112 S ORSRC=$G(ORSRC) 113 D DELPI^ORWDX1 ;delete empty PI 114 I $G(ORIFN)="" D ; new order 115 . D EN^ORCSAVE 116 . S REC="" I ORIFN D GETBYIFN^ORWORR(.REC,ORIFN) 117 . I '$D(^TMP("ORECALL",$J,ORDIALOG)) M ^TMP("ORECALL",$J,ORDIALOG)=ORDIALOG 118 E D 119 . N OR0 120 . S OR0=$G(^OR(100,+ORIFN,0)),ORSTS=$P($G(^(3)),U,3),ORDG=$P(OR0,U,11) 121 . I $L($P(OR0,U,17)),ORSTS=10 S OREVENT=$P(OR0,U,17),OREVENT("TS")=$P(OR0,U,13) 122 . D XX^ORCSAVE ; edit order 123 . S REC="" S ORIFN=+ORIFN_";"_ORDA D GETBYIFN^ORWORR(.REC,ORIFN) 124 Q 125 SENDED(ORWLST,ORIENS,TS,LOC) ; Release EDOs to svc 126 N OK,ORVP,ORWERR,ORSIGST,ORDA,ORNATURE,ORIX,X,PTEVT,ORIFN,J,EVENT,LOCK 127 S ORWERR="",ORIX=0,LOC=LOC_";SC(" 128 F S ORIX=$O(ORIENS(ORIX)) Q:'ORIX D 129 . S ORIFN=ORIENS(ORIX) 130 . S PTEVT=$P(^OR(100,+ORIFN,0),U,17) I PTEVT S LOCK=$$LCKEVT^ORX2(PTEVT) S:LOCK EVENT(PTEVT)="" I 'LOCK S ORWERR="1^delayed event is locked - another user is processing orders for this event" ;195 131 . S ORDA=$P(ORIFN,";",2) S:'ORDA ORDA=1 132 . S ORVP=$P($G(^OR(100,+ORIFN,0)),U,2) 133 . I $D(^OR(100,+ORIFN,8,ORDA,0)) D 134 .. S ORSIGST=$P($G(^(0)),U,4) 135 .. S ORNATURE=$P($G(^(0)),U,12) 136 . S:$G(LOC) $P(^OR(100,+ORIFN,0),U,10)=LOC ;set location 137 . S:$G(TS) $P(^OR(100,+ORIFN,0),U,13)=TS ;set specialty 138 . S OK=$$LOCK1^ORX2(ORIFN) I 'OK S ORWERR="1^"_$P(OK,U,2) 139 . I OK,$G(LOCK) D EN2^ORCSEND(ORIENS(ORIX),ORSIGST,ORNATURE,.ORWERR),UNLK1^ORX2(ORIENS(ORIX)) ;add ,LOCK to if statement for 195 140 . S ORWLST(ORIX)=ORIENS(ORIX) 141 . I $L(ORWERR) S ORWLST(ORIX)=ORWLST(ORIX)_"^E^"_ORWERR Q 142 . E D 143 .. S PTEVT=$P($G(^OR(100,+ORIENS(ORIX),0)),U,17) 144 .. D:$$TYPE^OREVNTX(PTEVT)="M" SAVE^ORMEVNT1(ORIENS(ORIX),PTEVT,2) 145 . S X="RS" 146 . S $P(ORWLST(ORIX),U,2)=X 147 S J=0 F S J=$O(EVENT(J)) Q:'+J D UNLEVT^ORX2(J) ;195 148 Q 149 SEND(ORWLST,DFN,ORNP,ORL,ES,ORWREC) ; Sign 150 ; DFN=Patient, ORNP=Provider, ORL=Location, ES=Encrypted ES code 151 ; ORWREC(n)=ORIFN;Action^Signature Sts^Release Sts^Nature of Order 152 SEND1 N ORVP,ORWI,ORWERR,ORWREL,ORWSIG,ORWNATR,ORDERID,ORBEF,ORLR,ORLAB,X,I 153 S ORVP=DFN_";DPT(",ORL=ORL_";SC(",ORL(2)=ORL,ORWLST=0 154 F I="LR","VBEC" S X=+$O(^DIC(9.4,"C",I,0)) S:X ORLR(X)=1 155 S ORWI=0 F S ORWI=$O(ORWREC(ORWI)) Q:'ORWI D 156 . S X=ORWREC(ORWI),ORWERR="" 157 . S ORDERID=$P(X,U),ORWSIG=$P(X,U,2),ORWREL=$P(X,U,3),ORWNATR=$P(X,U,4) 158 . S ORBEF=0 159 . I '$D(^OR(100,+ORDERID,0)) Q 160 . I $D(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0)) S ORBEF=$P(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0),U,15) 161 . S:$D(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0)) ORWNATR=$S($P(^OR(100,+ORDERID,8,+$P(ORDERID,";",2),0),"^",4)=3:"",1:ORWNATR) 162 . S ORWERR=$$CHKACT^ORWDXR(ORDERID,ORWSIG,ORWREL,ORWNATR) 163 . I $L(ORWERR) S ORWERR="1^"_ORWERR 164 . I '$L(ORWERR) D 165 .. I $G(ORLR(+$P(^OR(100,+ORDERID,0),U,14))),'$G(ORLAB) D ; lab batch start 166 ... I $L($T(BHS^ORMBLD)) D BHS^ORMBLD(ORVP) S ORLAB=1 167 .. N OK S OK=$$LOCK1^ORX2(ORDERID) I 'OK S ORWERR="1^"_$P(OK,U,2) 168 .. I OK D EN^ORCSEND(ORDERID,"",ORWSIG,ORWREL,ORWNATR,"",.ORWERR),UNLK1^ORX2(ORDERID) 169 .. S PSOSITE=$G(^SC(+ORL,"AFRXSITE")) ;+ORL is hospital location from ORWDX 170 .. Q:PSOSITE="" ;Quits with no autofinish if File#44 does not point to File#59 171 .. I $P($G(^PS(59,PSOSITE,"RXFIN")),"^",1)="Y",$$GET1^DIQ(100,+ORDERID_",",12)="OUTPATIENT PHARMACY" D EN^PSOAFIN ;vfam 172 . S ORWLST(ORWI)=ORDERID,X="" 173 . I $L(ORWERR) S ORWLST(ORWI)=ORWLST(ORWI)_"^E^"_ORWERR Q 174 . I ORWREL,((ORBEF=10)!(ORBEF=11)),($P(^OR(100,+ORDERID,3),U,3)'=10) S X="R" 175 . I ORWSIG'=2 S X=X_"S" 176 . S $P(ORWLST(ORWI),U,2)=X 177 I $G(ORLAB) D BTS^ORMBLD(ORVP) 178 Q 179 EXTVAL(IVAL,DLG) ; External value given a dlg ptr 180 N ORDIALOG 181 S ORDIALOG(DLG,0)=$P($G(^ORD(101.41,DLG,1)),U,1,2) 182 S ORDIALOG(DLG,1)=IVAL 183 I $E(ORDIALOG(DLG,0))="R",(+IVAL'=IVAL) Q IVAL ; free text date/time 184 Q $$EXT^ORCD(DLG,1) ; all others 185 DLGID(VAL,ORIFN) ; return dlg IEN for order 186 S VAL=$P(^OR(100,+ORIFN,0),U,5) 187 S VAL=$S($P(VAL,";",2)="ORD(101.41,":+VAL,1:0) 188 Q 189 FORMID(VAL,ORIFN) ; Base dlg FormID for an order 190 N DLG 191 S VAL=0,DLG=$P(^OR(100,+ORIFN,0),U,5) 192 Q:$P(DLG,";",2)'="ORD(101.41," 193 D FORMID^ORWDXM(.VAL,+DLG) 194 Q 195 AGAIN(VAL,DLG) ; return true to keep dlg for another order 196 S VAL=''$P($G(^ORD(101.41,DLG,0)),U,9) 197 Q 198 DGRP(VAL,DLG) ; Display grp pointer for a dlg 199 S DLG=$S($E(DLG)="`":+$P(DLG,"`",2),1:$O(^ORD(101.41,"AB",DLG,0))) ;kcm 200 S VAL=$P($G(^ORD(101.41,DLG,0)),U,5) 201 Q 202 DGNM(VAL,NM) ; Display grp pointer for name 203 S VAL=$O(^ORD(100.98,"B",NM,0)) 204 Q 205 WRLST(LST,LOC) ; List of dlgs for writing orders 206 G WRLST1^ORWDX1 207 MSG(LST,IEN) ; Msg text for orderable item 208 N I 209 S I=0 F S I=$O(^ORD(101.43,IEN,8,I)) Q:I'>0 S LST(I)=^(I,0) 210 Q 211 DISMSG(VAL,IEN) ; Disabled mge for ordering dlg 212 S VAL=$P($G(^ORD(101.41,+IEN,0)),U,3) 213 Q 214 LOCK(OK,DFN) ; Attempt to lock pt for ordering 215 S OK=$$LOCK^ORX2(DFN) 216 Q 217 UNLOCK(OK,DFN) ; Unlock pt for ordering 218 D UNLOCK^ORX2(DFN) S OK=1 219 Q 220 LOCKORD(OK,ORIFN) ; Attempt to lock order 221 S OK=$$LOCK1^ORX2(ORIFN) 222 Q 223 UNLKORD(OK,ORIFN) ; Unlock order 224 D UNLK1^ORX2(ORIFN) S OK=1 225 Q
Note:
See TracChangeset
for help on using the changeset viewer.
