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