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

ORCACT4.m

Go to the documentation of this file. 
  1. ORCACT4 ;SLC/MKB-Act on orders cont ; 08 May 2002  2:12 PM
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,116,141,149,190**;Dec 17, 1997
  1. XX ; -- Edit/Change order ORIFN
  1.  N ORDIALOG,ORQUIT,FIRST,X,OREDIT,ORCHECK,ORSTS,ORDA,OR0,ORDG,ORNMSP,OREVENT,ORDUZ,ORLOG,ORTYPE
  1.  K ^TMP("ORWORD",$J) S FIRST=0,ORTYPE="D"
  1.  S OR0=$G(^OR(100,+ORIFN,0)),ORSTS=$P(^(3),U,3),ORDG=$P(OR0,U,11)
  1.  I $P(OR0,U,17),ORSTS=10 S OREVENT=$P(OR0,U,17)
  1.  S OREDIT=$S(ORSTS=11:0,ORSTS=10:0,1:1),ORNMSP=$$NMSP^ORCD($P(OR0,U,14))
  1.  S X=$P(OR0,U,5) I X'["101.41" D  ; 2.5
  1.  . N X,WP S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
  1.  . D GETDLG^ORCD(ORDIALOG) S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1")
  1.  . S ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)"
  1.  . M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1) ; edit order text
  1.  . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
  1.  I X["101.41" S ORDIALOG=+X S:$P($G(^ORD(101.41,+X,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4) D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
  1.  X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) XXQ ; entry action
  1.  D DISPLAY^ORCHECK ;pkg order checks
  1. XX1 D DIALOG^ORCDLG G:$G(ORQUIT)&FIRST XXQ
  1.  I '$$CHANGED W !!,"Nothing changed!" H 2 Q
  1.  D ACCEPT^ORCHECK(),DISPLAY^ORCDLG S X=$$OK(ORACT)
  1.  G:X="^" XXQ I X="E" K ORCHECK G XX1
  1.  I X="C" W !?10,"... changes cancelled.",! G XXQ
  1.  I X="P" D XX^ORCSAVE W !?10,$S(ORIFN:"... changes placed.",1:"ERROR"),! S:ORIFN ^TMP("ORNEW",$J,ORIFN,1)=""
  1. XXQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J) ; exit action
  1.  Q
  1.  ;
  1. CHANGED() ; -- Returns 1 or 0, if order was actually changed
  1.  N OROLD,P,I,Y D GETORDER^ORCD(+ORIFN,"OROLD") S Y=0
  1.  S P=0 F  S P=$O(ORDIALOG(P)) Q:P'>0  D  Q:Y
  1.  . S I=0 F  S I=$O(OROLD(P,I)) Q:I'>0  D CHK Q:Y
  1.  . Q:Y  S I=0 F  S I=$O(ORDIALOG(P,I)) Q:I'>0  D CHK Q:Y
  1.  Q Y
  1.  ;
  1. CHK N OLD,NEW S OLD=$G(OROLD(P,I)),NEW=$G(ORDIALOG(P,I)) S:NEW'=OLD Y=1
  1.  ;I $E(ORDIALOG(P,0))'="W" S:NEW'=OLD Y=1 Q
  1.  ;I @OLD@(0)'=@NEW@(0) S Y=1
  1.  Q
  1.  ;
  1. RN ; -- Renew order ORIFN
  1.  N ORDIALOG,ORQUIT,FIRST,ORENEW,ORCHECK,ORDA,OR0,OR3,ORDG,ORNMSP,ORDUZ,ORLOG,ORTYPE,X
  1.  K ^TMP("ORWORD",$J) S FIRST=0,ORENEW=1,ORTYPE="D"
  1.  S OR0=$G(^OR(100,+ORIFN,0)),OR3=$G(^(3)),ORDIALOG=+$P(OR0,U,5)
  1.  S ORNMSP=$$NMSP^ORCD($P(OR0,U,14)),ORDG=$P(OR0,U,11)
  1.  I $P(OR3,U,9) D  Q:$G(ORQUIT)
  1.  . I $$DOSES($P(OR3,U,9))'>1 Q  ;dose+Now only - ok
  1.  . W !,$C(7),"This is part of a complex order, which must be renewed in its entirety:"
  1.  . S I=0 F  S I=$O(^OR(100,+$P(OR3,U,9),8,1,.1,I)) Q:I<1  S X=$G(^(I,0)) W:$$UP^XLFSTR(X)'=" FIRST DOSE NOW" !,X
  1.  . S:'$$OKALL ORQUIT=1 I '$G(ORQUIT) S ORIFN=+$P(OR3,U,9)
  1.  I $P(OR0,U,5)["101.41" S:$P($G(^ORD(101.41,ORDIALOG,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4) D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN) K ORDIALOG($$PTR^ORCD("OR GTX NOW"),1)
  1.  I $P(OR0,U,5)'["101.41" D  ; protocol -> use WP dialog for renewal
  1.  . N STOP,WP,X S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
  1.  . D GETDLG^ORCD(ORDIALOG)
  1.  . S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1)
  1.  . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
  1.  . S STOP=$P(OR0,U,9) I STOP,STOP>$$NOW^XLFDT S ORDIALOG($$PTR^ORCD("OR GTX START DATE/TIME"),1)=STOP
  1.  X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) RNQ ; entry action
  1.  D DISPLAY^ORCHECK ;pkg order checks
  1. RN1 D DIALOG^ORCDLG G:$G(ORQUIT) RNQ
  1.  D ACCEPT^ORCHECK() S X="P"
  1.  I $G(ORCHECK) D DISPLAY^ORCDLG S X=$$OK(ORACT) G:X="^" RNQ
  1.  I X="C" W !?10,"... renewal cancelled.",! G RNQ
  1.  I X="P" D RN^ORCSAVE W !?10,$S(ORIFN:"... order renewed.",1:"ERROR"),! S:ORIFN ^TMP("ORNEW",$J,ORIFN,1)=""
  1. RNQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J)
  1.  Q
  1.  ;
  1. DOSES(IFN) ; -- Return #doses in order IFN
  1.  N I,P,CNT S (I,CNT)=0
  1.  F  S I=$O(^OR(100,IFN,4.5,"ID","INSTR",I)) Q:I<1  S CNT=CNT+1
  1.  Q CNT
  1.  ;
  1. OKALL() ; -- OK to renew all child orders of complex?
  1.  N X,Y,DIR,DTOUT,DUOUT,DIROUT,DIRUT
  1.  S DIR(0)="YA",DIR("A")=" ...OK? ",DIR("B")="YES"
  1.  S DIR("?")="Enter YES to continue and renew the entire complex order as shown, or NO to quit."
  1.  D ^DIR S:$D(DTOUT)!(X["^") Y="^"
  1.  Q Y
  1.  ;
  1. RW ; -- Rewrite order ORIFN
  1.  N ORDIALOG,ORQUIT,FIRST,OREWRITE,ORCHECK,ORDA,OR0,ORDG,ORNMSP,ORDUZ,ORLOG,ORTYPE,X
  1.  K ^TMP("ORWORD",$J) S FIRST=1,OREWRITE=1,ORTYPE="D"
  1.  S OR0=$G(^OR(100,+ORIFN,0)),ORNMSP=$$NMSP^ORCD($P(OR0,U,14)),ORDG=$P(OR0,U,11),ORDIALOG=+$P(OR0,U,5)
  1.  I $P(OR0,U,5)["101.41" D  ;get dialog, responses
  1.  . S:$P($G(^ORD(101.41,ORDIALOG,0)),U,4)'="D" ORDIALOG=+$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,4)
  1.  . I ORNMSP="PS",$G(OREVENT) D  ;use generic Meds dlg
  1.  .. N X S X=$P($G(^ORD(100.98,+ORDG,0)),U,3)
  1.  .. Q:X="IV RX"  Q:X="SPLY"  ;don't switch these
  1.  .. S ORDIALOG=+$O(^ORD(101.41,"AB","PS MEDS",0))
  1.  . D GETDLG^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
  1.  . S X=$$PTR^ORCD("OR GTX URGENCY") K:$G(ORDIALOG(X,1))=99 ORDIALOG(X,1)
  1.  I $P(OR0,U,5)'["101.41" D  ; protocol -> use WP dialog for renewal
  1.  . N WP,X S ORDIALOG=$$PTR^ORCD("OR GXTEXT WORD PROCESSING ORDER")
  1.  . D GETDLG^ORCD(ORDIALOG)
  1.  . S WP=$$PTR^ORCD("OR GTX WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^OR(100,+ORIFN,1)
  1.  . S X=$O(^TMP("ORWORD",$J,WP,1,0)) I X,$E(^(X,0),1,3)=">> " S ^TMP("ORWORD",$J,WP,1,X,0)=$E(^OR(100,+ORIFN,1,X,0),4,999)
  1.  X:$D(^ORD(101.41,+ORDIALOG,3)) ^(3) G:$G(ORQUIT) RWQ
  1.  D DISPLAY^ORCHECK ;pkg order checks
  1. RW1 D DIALOG^ORCDLG G:$G(ORQUIT)&FIRST RWQ
  1.  D ACCEPT^ORCHECK() ;($S(FIRST:"ALL",1:""))
  1.  I $G(OREVENT),$G(^ORE(100.2,+OREVENT,1)) D  ;event occurred
  1.  . W !!,"This release event has occurred since you started copying delayed orders."
  1.  . W !,"The orders that were signed have now been released; this and any other"
  1.  . W !,"unsigned orders will be released immediately upon signature."
  1.  . N X W !!,"Press <return> to continue ..." R X:DTIME K OREVENT
  1.  D DISPLAY^ORCDLG S X=$$OK^ORCDLG G:X="^" RWQ
  1.  I X="E" S FIRST=0 K ORCHECK G RW1
  1.  I X="C" W !?10,"... order cancelled.",! G RWQ
  1.  I X="P" D
  1.  . N OLDIFN,ORSRC S OLDIFN=+ORIFN,ORSRC="C" K ORIFN D EN^ORCSAVE
  1.  . W !?10,$S($G(ORIFN):"... order rewritten.",1:"ERROR"),!
  1.  . I $G(ORIFN) S ^TMP("ORNEW",$J,ORIFN,1)="" S:$D(^OR(100,OLDIFN,5)) ^OR(100,ORIFN,5)=^OR(100,OLDIFN,5)
  1. RWQ X:$D(^ORD(101.41,+ORDIALOG,4)) ^(4) K ^TMP("ORWORD",$J)
  1.  Q
  1.  ;
  1. HD ; -- Hold order ORIFN
  1.  N X S X=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP) Q:'X
  1.  S ^TMP("ORNEW",$J,+ORIFN,X)=""
  1.  W !?10,"... hold order placed."
  1.  Q
  1.  ;
  1. RL ; -- Release hold on order ORIFN
  1.  N X S X=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP) Q:'X
  1.  S ^TMP("ORNEW",$J,+ORIFN,X)=""
  1.  W !?10,"... release hold order placed."
  1.  Q
  1.  ;
  1. OK(ACT) ; -- Ready to save?
  1.  N X,Y,DIR
  1.  S DIR(0)="SA^P:PLACE;C:CANCEL;"_$S(ACT'="RN":"E:EDIT;",1:"")
  1.  S:ACT="XX" DIR("A")="(P)lace, (E)dit, or (C)ancel changes? ",DIR("?")="Enter P to save the changes to this order, or E to change any of the displayed values; enter C to quit without changing this order"
  1.  S:ACT="RN" DIR("A")="(P)lace or (C)ancel renewal? ",DIR("?")="Enter P to save this renewal or C to quit without renewing this order"
  1.  S DIR("B")="PLACE" D ^DIR S:$D(DTOUT) Y="^"
  1.  Q Y