Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORCACT

ORCACT.m

Go to the documentation of this file.
  1. ORCACT ; SLC/MKB - Act on orders ;4/2/02 16:41
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,48,92,94,141**;Dec 17, 1997
  1. ADD ; -- add new order via NW on pkg results tab
  1. ; Requires ORDIALOG = name of pkg dialog
  1. N ORPTLK,OREVENT,X S VALMBCK="" G:'$L($G(ORDIALOG)) ADQ
  1. S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q
  1. D FREEZE^ORCMENU S VALMBCK="R"
  1. I $G(ORTAB)'="COVER" S X=$$DELAY G:X="^" ADQ I X D G:X="^" ADQ
  1. . S X=$$PTEVENT^OREVNT(+ORVP,1)
  1. . S:X'="^" OREVENT=+X
  1. S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" ADQ
  1. S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 G:ORL["^" ADQ
  1. S ORDIALOG=$O(^ORD(101.41,"AB",$E(ORDIALOG,1,63),0)) G:'ORDIALOG ADQ
  1. D ADD^ORCDLG,REBLD^ORCMENU:$D(^TMP("ORNEW",$J))
  1. K ORDIALOG,^TMP("ORWORD",$J),^TMP("ORECALL",$J) S VALMBCK="R"
  1. ADQ S:$D(^TMP("OR",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
  1. Q
  1. ;
  1. EDIT ; -- change orders
  1. D EN("XX") Q
  1. ;
  1. RENEW ; -- renew orders
  1. D EN("RN") Q
  1. ;
  1. REWRITE ; -- rewrite orders
  1. N OREVENT,X S X=$$DELAY Q:X="^" I X D Q:X="^"
  1. . S X=$$PTEVENT^OREVNT(+ORVP,1)
  1. . S:X'="^" OREVENT=+X
  1. D EN("RW") Q
  1. ;
  1. HOLD ; -- hold orders
  1. D EN("HD") Q
  1. ;
  1. UNHOLD ; -- release hold on orders
  1. D EN("RL") Q
  1. ;
  1. EN(ORACT) ; -- start here with:
  1. ; ORNMBR = #,#,...,# of selected orders
  1. ; ORACT = action to be taken on orders
  1. ;
  1. ; OREBUILD defined on return if Orders tab needs to be rebuilt
  1. ;
  1. N ORI,NMBR,ORQUIT,ORIFN,ORIG,ORSIG,OREL,ORPTLK,ORLK,IDX,ORDITM,ORPRINT,ORERR,ORDER,ORSTS,ORPRNT,ORNOW,ORDG,ORXNP S VALMBCK=""
  1. S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q
  1. I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") G:'ORNMBR ENQ
  1. D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
  1. S ORNP=$$PROVIDER^ORCMENU1 G:ORNP="^" ENQ
  1. S:'$G(ORL) ORL=$$LOCATION^ORCMENU1 G:ORL="^" ENQ
  1. EN1 F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) D:NMBR Q:$D(ORQUIT)
  1. . S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR))
  1. . S ORIFN=$S(ORTAB="MEDS":$P(IDX,U,4),1:$P(IDX,U)) Q:'ORIFN
  1. . I '$D(^OR(100,+ORIFN,0)) W !,"This order has been deleted!" H 2 Q
  1. . S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";"_+$P($G(^OR(100,+ORIFN,3)),U,7)
  1. . S ORIG=+ORIFN,ORDITM=$$ORDITEM(ORIFN) D SUBHDR(ORDITM)
  1. . I '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR) W !,ORERR H 2 Q
  1. . I $$NMSP^ORCD(+$P(^OR(100,+ORIFN,0),U,14))="PS" D PROVIDER^ORCDPSIV Q:$G(ORQUIT)
  1. . S ORLK=$S('$D(^TMP("ORNEW",$J,ORIG)):$$LOCK1^ORX2(ORIG),1:1) I 'ORLK W !,$P(ORLK,U,2) H 2 Q
  1. . D @(ORACT_"^ORCACT4") ;sets ^TMP("ORNEW",$J,ORIFN),[ORIFN]
  1. . D:'$O(^TMP("ORNEW",$J,ORIG,0)) UNLK1^ORX2(ORIG) ;unlk if not chngd
  1. S:$O(^TMP("ORNEW",$J,0)) OREBUILD=1
  1. ENQ D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) ;unlock if no new orders
  1. S:$G(ORXNP) ORNP=ORXNP
  1. Q
  1. ;
  1. ORDITEM(ID) ; -- Returns order text
  1. ;N X,I,MORE S X=""
  1. ;I $P(ID,";",2)>1 S I=$P($G(^OR(100,+ID,8,+$P(ID,";",2),0)),U,2),X=$S(I="DC":"Discontinue ",I="HD":"Hold ",1:"")
  1. ;S I=$O(^OR(100,+ID,1,0)) Q:'I "" S MORE=$O(^(I)),X=X_$G(^(I,0))
  1. ;I $L(X)>68 S MORE=1,X=$E(X,1,68)
  1. ;S:MORE X=X_" ..."
  1. N X,ORX D TEXT^ORQ12(.ORX,ID,68) S X=ORX(1)_$S(ORX>1:" ...",1:"")
  1. Q X
  1. ;
  1. SUBHDR(X) ; -- Display subheader of order being acted on
  1. W !!,?(36-($L(X)\2)),"-- "_X_" --",!
  1. Q
  1. ;
  1. DELAY() ; -- Delay release of orders?
  1. I '$D(^ORD(100.5,"C")) Q 0 ;no active events
  1. N X,Y,DIR S DIR(0)="YA",DIR("B")="NO"
  1. S DIR("A")="Delay release of these orders? "
  1. S DIR("?")="Enter NO to release these orders immediately upon signature; YES will delay release of these orders until the specified patient movement occurs."
  1. D ^DIR S:$D(DTOUT)!$D(DUOUT) Y="^"
  1. Q Y
  1. ;
  1. EX ; -- exit action
  1. I $G(OREBUILD) D ;rebuild tabs
  1. . I $G(ORTAB)="ORDERS"!($G(ORTAB)="DELAY") D Q
  1. .. N TAB D TAB^ORCHART(ORTAB,1)
  1. .. F TAB="MEDS","CONSULTS" S:$D(^TMP("OR",$J,TAB,0)) $P(^(0),U)=""
  1. . S:$D(^TMP("OR",$J,"ORDERS",0)) $P(^(0),U)="" ;rebld next time
  1. . D:$G(ORTAB)="NEW" INIT^ORCMENU2 ;when called from RV
  1. I $G(ORTAB)'="NEW",$D(^TMP("OR",$J,"CURRENT","MENU")) S XQORM("HIJACK")=^("MENU")
  1. Q