- ORCACT1 ;SLC/MKB,ASMR/BL-Act on orders cont ; 10/16/15 1:36pm
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,56,48,86,92,116,149,215,284,390**;Dec 17, 1997;Build 425
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- FLAG ; -- flag orders
- D EN("FL") Q
- ;
- UNFLAG ; -- unflag orders
- D EN("UF") Q
- ;
- D EN("CM") Q
- ;
- ALERT ; -- alert provider when results available
- D EN("AL") Q
- ;
- UNHOLD ; -- release hold on orders - no longer in use
- Q ; see UNHOLD^ORCACT instead
- ;
- EN(ORACT) ; -- Actions that don't create orders
- ; ORNMBR = #,#,...,# of selected orders
- ; ORACT = action to be taken
- ;
- ; OREBUILD defined on return if Orders tab needs to be rebuilt
- ;
- N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORERR,ORQUIT
- I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
- D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
- 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)),ORIFN=$P(IDX,U)
- . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1"
- . I '$D(^OR(100,+ORIFN,0)) W !,"This order has been deleted!" H 1 Q
- . S ORDITM=$$ORDITEM^ORCACT(ORIFN) D SUBHDR^ORCACT(ORDITM)
- . I '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR) W !,ORERR H 1 Q
- . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !,$P(ORLK,U,2) H 1 Q
- . D @ORACT,UNLK1^ORX2(+ORIFN)
- ENQ Q
- ;
- FL ; -- Flag order ORIFN
- D EN^ORCFLAG
- Q
- ;
- UF ; -- Unflag order ORIFN
- D UN^ORCFLAG
- Q
- ;
- CM ; -- Ward Comments on order ORIFN
- N DIC,DWPK,DIWEPSE,DIWESUB,DDWRW
- S DIC="^OR(100,"_+ORIFN_",8,"_+$P(ORIFN,";",2)_",5,",(DWPK,DIWEPSE)=1
- S DIWESUB=ORDITM,DDWRW="B" ;go to bottom of text
- D EN^DIWE
- Q
- ;
- AL ; -- Alert when results are available for order ORIFN
- S $P(^OR(100,+ORIFN,3),U,10)=1
- W !?10,"... done." H 1
- Q
- ;
- RL ; -- Release hold on order ORIFN [No longer used]
- D EN^ORCSEND(+ORIFN,ORACT,3,1,,,.ORERR)
- W !,"... order "_$S($G(ORERR):"not ",1:"")_"released from hold."
- W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) H 1
- S OREBUILD=1 ; print?
- Q
- ;
- VERIFY(ORVER) ; -- Verify orders
- N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,OROLDSTS,ORNEW,ORWAIT
- I "^"[$G(ORVER) W $C(7),!!,"You must be a nurse or clerk to verify these orders!" S VALMBCK="" H 2 Q
- I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
- D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
- 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)),ORIFN=$P(IDX,U)
- . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1" Q:$D(ORES(ORIFN))
- . I '$$VALID^ORCACT0(ORIFN,"VR",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
- . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
- . S ORES(ORIFN)="" D REPLCD
- VR1 Q:'$O(ORES(0)) D COMPLX S ORSIG=$S($$ESIG^ORCSIGN:1,1:0)
- I 'ORSIG W !,"Nothing verified!" D UNLOCK H 1 Q
- W !!,"Verifying orders ..."
- S ORIFN=0 F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D
- . S OROLDSTS=+$P($G(^OR(100,+ORIFN,3)),U,3)
- . D EN^ORCSEND(ORIFN,"VR","","",,,.ORERR),UNLK1^ORX2(+ORIFN)
- . I $G(ORERR) D Q
- . . W !,$$ORDITEM^ORCACT(ORIFN)_" not verified."
- . . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2) H 1
- . S ORNEW=+$P($G(^OR(100,+ORIFN,3)),U,3) I ORNEW'=OROLDSTS W !,$$ORDITEM^ORCACT(ORIFN)_" is now "_$$STS(ORNEW)_"." S ORWAIT=1
- S OREBUILD=1 D:'$D(XQAID) CKALERT I $G(ORWAIT) H 2
- VRQ Q
- ;
- STS(X) ; -- Return name of status X
- N Y S Y=$P($G(^ORD(100.01,+$G(X),0)),U)
- Q Y
- ;
- REPLCD ; -- Ck for unverified replaced orders for ORIFN, add to ORES(order#)
- ; [Expects ORVER; also called from VERIFY^ORWDXA,VERIFY^ORRCOR]
- N OR3,ORIG,ORFLD,ORDA,ORI,ORLK
- S ORFLD=$S($G(ORVER)="N":8,$G(ORVER)="R":18,1:10),ORDA=+$P(ORIFN,";",2)
- I ORDA>1 D Q ;ck for prior unverified actions
- . ;Q:$P($G(^OR(100,+ORIFN,8,ORDA,0)),U,2)'="XX"
- . S ORI=0 F S ORI=$O(^OR(100,+ORIFN,8,ORI)) Q:ORI<1 Q:ORI'<ORDA D
- .. Q:$P($G(^OR(100,+ORIFN,8,ORI,0)),U,ORFLD) ;already verified
- .. S ORLK=$$LOCK1^ORX2(+ORIFN) Q:'ORLK
- .. S ORES(+ORIFN_";"_ORI)=""
- S OR3=$G(^OR(100,+ORIFN,3)) Q:$P(OR3,U,11)'=1
- S ORIG=+$P(OR3,U,5) Q:'ORIG Q:$P($G(^OR(100,ORIG,3)),U,3)'=12
- S ORDA=0 F S ORDA=$O(^OR(100,ORIG,8,ORDA)) Q:ORDA'>0 I '$P($G(^(ORDA,0)),U,ORFLD) D
- . S ORLK=$$LOCK1^ORX2(ORIG) Q:'ORLK
- . S ORES(ORIG_";"_ORDA)=""
- Q
- ;
- COMPLX ; -- Ck for other child orders to be verified at same time
- N IFN,DAD,CHLD,ALL,P,X,I
- S P=$S(ORVER="N":9,ORVER="C":11,ORVER="R":19,1:0) Q:P<1
- S IFN=0 F S IFN=$O(ORES(IFN)) Q:IFN<1 D
- . S X=+$P($G(^OR(100,+IFN,0)),U,14) Q:$$NMSP^ORCD(X)'["PS"
- . S X=$P($G(^OR(100,+IFN,8,+$P(IFN,";",2),0)),U,2) Q:X'="NW"&(X'="XX")
- . I $P($G(^OR(100,+IFN,3)),U,9) S DAD(+$P(^(3),U,9))=""
- Q:'$O(DAD(0)) S IFN=0 F S IFN=+$O(DAD(IFN)) Q:IFN<1 D
- . S CHLD=0,ALL=1
- . F S CHLD=+$O(^OR(100,IFN,2,CHLD)) Q:CHLD<1 F X="NW","XX" D
- .. S I=+$O(^OR(100,CHLD,8,"C",X,0)) Q:I<1
- .. Q:$P($G(^OR(100,CHLD,8,I,0)),U,P) Q:$D(ORES(CHLD_";"_I))
- .. S ORES(CHLD_";"_I)="",ALL=0
- . Q:ALL S X=$$ORDITEM^ORCACT(IFN) D SUBHDR^ORCACT(X)
- . W !,"All doses of this complex order must be verified together;"
- . W !,"adding remaining doses to signature list..."
- Q
- ;
- CKALERT ; -- Ck if Unverified Orders alerts can be deleted
- N ORNOW,ORBEG,ORLIST,ORALL,ORMEDS S ORNOW=$$NOW^XLFDT
- S:'$G(ORWARD) ORBEG=$$FMADD^XLFDT(ORNOW,"-30") I $G(ORWARD) D
- . N DFN,VAIN,VAERR S DFN=+ORVP D INP^VADPT
- . S ORBEG=$S($G(VAIN(7)):$P(VAIN(7),U),1:$$FMADD^XLFDT(ORNOW,-30))
- D EN^ORQ1(ORVP,,9,,ORBEG,ORNOW) ;see if any unverified orders remain
- I $G(ORLIST),$G(^TMP("ORR",$J,ORLIST,"TOT")) D ;see if any are meds
- . N ORRX,ORGRP,I,IFN,DG S ORALL=1
- . S ORRX=+$O(^ORD(100.98,"B","RX",0)) D GRP^ORQ1(ORRX)
- . S I=0 F S I=$O(^TMP("ORR",$J,ORLIST,I)) Q:I'>0 S IFN=+^(I),DG=+$P($G(^OR(100,IFN,0)),U,11) I $D(ORGRP(DG)) S ORMEDS=1 Q
- D:'$G(ORALL) DELALRT("UNVERIFIED ORDER")
- D:'$G(ORMEDS) DELALRT("UNVERIFIED MEDICATION ORDER")
- Q
- ;
- DELALRT(X) ; -- delete alert X
- N ORNIFN,XQAKILL,XQAID
- S ORNIFN=+$O(^ORD(100.9,"B",X,0)) Q:ORNIFN'>0
- S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
- S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
- D DELETEA^XQALERT
- Q
- ;
- UNLOCK ; -- Unlock orders in ORES(ORIFN) [from VR1]
- F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
- Q
- ;
- SIGNREQD(IFN) ; -- Returns 2, 1, or 0, if order/actions need ES
- Q +$P($G(^OR(100,IFN,0)),U,16)
- ;
- SIGN ; -- Sign orders [no longer used]
- D EN^ORCSIGN
- Q
- ;
- COMPLETE ; -- complete orders
- N ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,ORSTOP
- I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("complete") Q:'ORNMBR
- D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
- 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)),ORIFN=$P(IDX,U)
- . Q:'ORIFN S:'$P(ORIFN,";",2) ORIFN=+ORIFN_";1"
- . I '$$VALID^ORCACT0(ORIFN,"CP",.ORERR) W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR H 1 Q
- . S ORLK=$$LOCK1^ORX2(+ORIFN) I 'ORLK W !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$P(ORLK,U,2) H 1 Q
- . S ORES(ORIFN)=""
- CP1 Q:'$O(ORES(0)) S ORSIG=$S($$ESIG^ORCSIGN:1,1:0)
- I 'ORSIG W !,"Nothing completed!" D UNLOCK H 1 Q
- W !!,"Completing orders ..." S ORSTOP=+$E($$NOW^XLFDT,1,12),ORIFN=0
- F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D
- . D COMP^ORCSAVE2(ORIFN,DUZ,ORSTOP),UNLK1^ORX2(+ORIFN)
- . D COMP^ORMBLDOR(ORIFN)
- S OREBUILD=1
- CPQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCACT1 7462 printed Feb 18, 2025@23:54:23 Page 2
- ORCACT1 ;SLC/MKB,ASMR/BL-Act on orders cont ; 10/16/15 1:36pm
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,56,48,86,92,116,149,215,284,390**;Dec 17, 1997;Build 425
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- FLAG ; -- flag orders
- +1 DO EN("FL")
- QUIT
- +2 ;
- UNFLAG ; -- unflag orders
- +1 DO EN("UF")
- QUIT
- +2 ;
- +1 DO EN("CM")
- QUIT
- +2 ;
- ALERT ; -- alert provider when results available
- +1 DO EN("AL")
- QUIT
- +2 ;
- UNHOLD ; -- release hold on orders - no longer in use
- +1 ; see UNHOLD^ORCACT instead
- QUIT
- +2 ;
- EN(ORACT) ; -- Actions that don't create orders
- +1 ; ORNMBR = #,#,...,# of selected orders
- +2 ; ORACT = action to be taken
- +3 ;
- +4 ; OREBUILD defined on return if Orders tab needs to be rebuilt
- +5 ;
- +6 NEW ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORERR,ORQUIT
- +7 IF '$GET(ORNMBR)
- SET ORNMBR=$$ORDERS^ORCHART("")
- if 'ORNMBR
- QUIT
- +8 DO FREEZE^ORCMENU
- SET VALMBCK="R"
- KILL OREBUILD
- +9 FOR ORI=1:1:$LENGTH(ORNMBR,",")
- SET NMBR=$PIECE(ORNMBR,",",ORI)
- if NMBR
- Begin DoDot:1
- +10 SET IDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
- SET ORIFN=$PIECE(IDX,U)
- +11 if 'ORIFN
- QUIT
- if '$PIECE(ORIFN,";",2)
- SET ORIFN=+ORIFN_";1"
- +12 IF '$DATA(^OR(100,+ORIFN,0))
- WRITE !,"This order has been deleted!"
- HANG 1
- QUIT
- +13 SET ORDITM=$$ORDITEM^ORCACT(ORIFN)
- DO SUBHDR^ORCACT(ORDITM)
- +14 IF '$$VALID^ORCACT0(ORIFN,ORACT,.ORERR)
- WRITE !,ORERR
- HANG 1
- QUIT
- +15 SET ORLK=$$LOCK1^ORX2(+ORIFN)
- IF 'ORLK
- WRITE !,$PIECE(ORLK,U,2)
- HANG 1
- QUIT
- +16 DO @ORACT
- DO UNLK1^ORX2(+ORIFN)
- End DoDot:1
- if $DATA(ORQUIT)
- QUIT
- ENQ QUIT
- +1 ;
- FL ; -- Flag order ORIFN
- +1 DO EN^ORCFLAG
- +2 QUIT
- +3 ;
- UF ; -- Unflag order ORIFN
- +1 DO UN^ORCFLAG
- +2 QUIT
- +3 ;
- CM ; -- Ward Comments on order ORIFN
- +1 NEW DIC,DWPK,DIWEPSE,DIWESUB,DDWRW
- +2 SET DIC="^OR(100,"_+ORIFN_",8,"_+$PIECE(ORIFN,";",2)_",5,"
- SET (DWPK,DIWEPSE)=1
- +3 ;go to bottom of text
- SET DIWESUB=ORDITM
- SET DDWRW="B"
- +4 DO EN^DIWE
- +5 QUIT
- +6 ;
- AL ; -- Alert when results are available for order ORIFN
- +1 SET $PIECE(^OR(100,+ORIFN,3),U,10)=1
- +2 WRITE !?10,"... done."
- HANG 1
- +3 QUIT
- +4 ;
- RL ; -- Release hold on order ORIFN [No longer used]
- +1 DO EN^ORCSEND(+ORIFN,ORACT,3,1,,,.ORERR)
- +2 WRITE !,"... order "_$SELECT($GET(ORERR):"not ",1:"")_"released from hold."
- +3 if $LENGTH($PIECE($GET(ORERR),U,2))
- WRITE !," >> "_$PIECE(ORERR,U,2)
- HANG 1
- +4 ; print?
- SET OREBUILD=1
- +5 QUIT
- +6 ;
- VERIFY(ORVER) ; -- Verify orders
- +1 NEW ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,OROLDSTS,ORNEW,ORWAIT
- +2 IF "^"[$GET(ORVER)
- WRITE $CHAR(7),!!,"You must be a nurse or clerk to verify these orders!"
- SET VALMBCK=""
- HANG 2
- QUIT
- +3 IF '$GET(ORNMBR)
- SET ORNMBR=$$ORDERS^ORCHART("")
- if 'ORNMBR
- QUIT
- +4 DO FREEZE^ORCMENU
- SET VALMBCK="R"
- KILL OREBUILD
- +5 FOR ORI=1:1:$LENGTH(ORNMBR,",")
- SET NMBR=$PIECE(ORNMBR,",",ORI)
- if NMBR
- Begin DoDot:1
- +6 SET IDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
- SET ORIFN=$PIECE(IDX,U)
- +7 if 'ORIFN
- QUIT
- if '$PIECE(ORIFN,";",2)
- SET ORIFN=+ORIFN_";1"
- if $DATA(ORES(ORIFN))
- QUIT
- +8 IF '$$VALID^ORCACT0(ORIFN,"VR",.ORERR)
- WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR
- HANG 1
- QUIT
- +9 SET ORLK=$$LOCK1^ORX2(+ORIFN)
- IF 'ORLK
- WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$PIECE(ORLK,U,2)
- HANG 1
- QUIT
- +10 SET ORES(ORIFN)=""
- DO REPLCD
- End DoDot:1
- if $DATA(ORQUIT)
- QUIT
- VR1 if '$ORDER(ORES(0))
- QUIT
- DO COMPLX
- SET ORSIG=$SELECT($$ESIG^ORCSIGN:1,1:0)
- +1 IF 'ORSIG
- WRITE !,"Nothing verified!"
- DO UNLOCK
- HANG 1
- QUIT
- +2 WRITE !!,"Verifying orders ..."
- +3 SET ORIFN=0
- FOR
- SET ORIFN=$ORDER(ORES(ORIFN))
- if ORIFN'>0
- QUIT
- Begin DoDot:1
- +4 SET OROLDSTS=+$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
- +5 DO EN^ORCSEND(ORIFN,"VR","","",,,.ORERR)
- DO UNLK1^ORX2(+ORIFN)
- +6 IF $GET(ORERR)
- Begin DoDot:2
- +7 WRITE !,$$ORDITEM^ORCACT(ORIFN)_" not verified."
- +8 if $LENGTH($PIECE($GET(ORERR),U,2))
- WRITE !," >> "_$PIECE(ORERR,U,2)
- HANG 1
- End DoDot:2
- QUIT
- +9 SET ORNEW=+$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
- IF ORNEW'=OROLDSTS
- WRITE !,$$ORDITEM^ORCACT(ORIFN)_" is now "_$$STS(ORNEW)_"."
- SET ORWAIT=1
- End DoDot:1
- +10 SET OREBUILD=1
- if '$DATA(XQAID)
- DO CKALERT
- IF $GET(ORWAIT)
- HANG 2
- VRQ QUIT
- +1 ;
- STS(X) ; -- Return name of status X
- +1 NEW Y
- SET Y=$PIECE($GET(^ORD(100.01,+$GET(X),0)),U)
- +2 QUIT Y
- +3 ;
- REPLCD ; -- Ck for unverified replaced orders for ORIFN, add to ORES(order#)
- +1 ; [Expects ORVER; also called from VERIFY^ORWDXA,VERIFY^ORRCOR]
- +2 NEW OR3,ORIG,ORFLD,ORDA,ORI,ORLK
- +3 SET ORFLD=$SELECT($GET(ORVER)="N":8,$GET(ORVER)="R":18,1:10)
- SET ORDA=+$PIECE(ORIFN,";",2)
- +4 ;ck for prior unverified actions
- IF ORDA>1
- Begin DoDot:1
- +5 ;Q:$P($G(^OR(100,+ORIFN,8,ORDA,0)),U,2)'="XX"
- +6 SET ORI=0
- FOR
- SET ORI=$ORDER(^OR(100,+ORIFN,8,ORI))
- if ORI<1
- QUIT
- if ORI'<ORDA
- QUIT
- Begin DoDot:2
- +7 ;already verified
- if $PIECE($GET(^OR(100,+ORIFN,8,ORI,0)),U,ORFLD)
- QUIT
- +8 SET ORLK=$$LOCK1^ORX2(+ORIFN)
- if 'ORLK
- QUIT
- +9 SET ORES(+ORIFN_";"_ORI)=""
- End DoDot:2
- End DoDot:1
- QUIT
- +10 SET OR3=$GET(^OR(100,+ORIFN,3))
- if $PIECE(OR3,U,11)'=1
- QUIT
- +11 SET ORIG=+$PIECE(OR3,U,5)
- if 'ORIG
- QUIT
- if $PIECE($GET(^OR(100,ORIG,3)),U,3)'=12
- QUIT
- +12 SET ORDA=0
- FOR
- SET ORDA=$ORDER(^OR(100,ORIG,8,ORDA))
- if ORDA'>0
- QUIT
- IF '$PIECE($GET(^(ORDA,0)),U,ORFLD)
- Begin DoDot:1
- +13 SET ORLK=$$LOCK1^ORX2(ORIG)
- if 'ORLK
- QUIT
- +14 SET ORES(ORIG_";"_ORDA)=""
- End DoDot:1
- +15 QUIT
- +16 ;
- COMPLX ; -- Ck for other child orders to be verified at same time
- +1 NEW IFN,DAD,CHLD,ALL,P,X,I
- +2 SET P=$SELECT(ORVER="N":9,ORVER="C":11,ORVER="R":19,1:0)
- if P<1
- QUIT
- +3 SET IFN=0
- FOR
- SET IFN=$ORDER(ORES(IFN))
- if IFN<1
- QUIT
- Begin DoDot:1
- +4 SET X=+$PIECE($GET(^OR(100,+IFN,0)),U,14)
- if $$NMSP^ORCD(X)'["PS"
- QUIT
- +5 SET X=$PIECE($GET(^OR(100,+IFN,8,+$PIECE(IFN,";",2),0)),U,2)
- if X'="NW"&(X'="XX")
- QUIT
- +6 IF $PIECE($GET(^OR(100,+IFN,3)),U,9)
- SET DAD(+$PIECE(^(3),U,9))=""
- End DoDot:1
- +7 if '$ORDER(DAD(0))
- QUIT
- SET IFN=0
- FOR
- SET IFN=+$ORDER(DAD(IFN))
- if IFN<1
- QUIT
- Begin DoDot:1
- +8 SET CHLD=0
- SET ALL=1
- +9 FOR
- SET CHLD=+$ORDER(^OR(100,IFN,2,CHLD))
- if CHLD<1
- QUIT
- FOR X="NW","XX"
- Begin DoDot:2
- +10 SET I=+$ORDER(^OR(100,CHLD,8,"C",X,0))
- if I<1
- QUIT
- +11 if $PIECE($GET(^OR(100,CHLD,8,I,0)),U,P)
- QUIT
- if $DATA(ORES(CHLD_";"_I))
- QUIT
- +12 SET ORES(CHLD_";"_I)=""
- SET ALL=0
- End DoDot:2
- +13 if ALL
- QUIT
- SET X=$$ORDITEM^ORCACT(IFN)
- DO SUBHDR^ORCACT(X)
- +14 WRITE !,"All doses of this complex order must be verified together;"
- +15 WRITE !,"adding remaining doses to signature list..."
- End DoDot:1
- +16 QUIT
- +17 ;
- CKALERT ; -- Ck if Unverified Orders alerts can be deleted
- +1 NEW ORNOW,ORBEG,ORLIST,ORALL,ORMEDS
- SET ORNOW=$$NOW^XLFDT
- +2 if '$GET(ORWARD)
- SET ORBEG=$$FMADD^XLFDT(ORNOW,"-30")
- IF $GET(ORWARD)
- Begin DoDot:1
- +3 NEW DFN,VAIN,VAERR
- SET DFN=+ORVP
- DO INP^VADPT
- +4 SET ORBEG=$SELECT($GET(VAIN(7)):$PIECE(VAIN(7),U),1:$$FMADD^XLFDT(ORNOW,-30))
- End DoDot:1
- +5 ;see if any unverified orders remain
- DO EN^ORQ1(ORVP,,9,,ORBEG,ORNOW)
- +6 ;see if any are meds
- IF $GET(ORLIST)
- IF $GET(^TMP("ORR",$JOB,ORLIST,"TOT"))
- Begin DoDot:1
- +7 NEW ORRX,ORGRP,I,IFN,DG
- SET ORALL=1
- +8 SET ORRX=+$ORDER(^ORD(100.98,"B","RX",0))
- DO GRP^ORQ1(ORRX)
- +9 SET I=0
- FOR
- SET I=$ORDER(^TMP("ORR",$JOB,ORLIST,I))
- if I'>0
- QUIT
- SET IFN=+^(I)
- SET DG=+$PIECE($GET(^OR(100,IFN,0)),U,11)
- IF $DATA(ORGRP(DG))
- SET ORMEDS=1
- QUIT
- End DoDot:1
- +10 if '$GET(ORALL)
- DO DELALRT("UNVERIFIED ORDER")
- +11 if '$GET(ORMEDS)
- DO DELALRT("UNVERIFIED MEDICATION ORDER")
- +12 QUIT
- +13 ;
- DELALRT(X) ; -- delete alert X
- +1 NEW ORNIFN,XQAKILL,XQAID
- +2 SET ORNIFN=+$ORDER(^ORD(100.9,"B",X,0))
- if ORNIFN'>0
- QUIT
- +3 SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
- +4 SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
- +5 DO DELETEA^XQALERT
- +6 QUIT
- +7 ;
- UNLOCK ; -- Unlock orders in ORES(ORIFN) [from VR1]
- +1 FOR
- SET ORIFN=$ORDER(ORES(ORIFN))
- if ORIFN'>0
- QUIT
- DO UNLK1^ORX2(+ORIFN)
- +2 QUIT
- +3 ;
- SIGNREQD(IFN) ; -- Returns 2, 1, or 0, if order/actions need ES
- +1 QUIT +$PIECE($GET(^OR(100,IFN,0)),U,16)
- +2 ;
- SIGN ; -- Sign orders [no longer used]
- +1 DO EN^ORCSIGN
- +2 QUIT
- +3 ;
- COMPLETE ; -- complete orders
- +1 NEW ORLK,ORI,NMBR,IDX,ORIFN,ORDITM,ORES,ORERR,ORSIG,ORSTOP
- +2 IF '$GET(ORNMBR)
- SET ORNMBR=$$ORDERS^ORCHART("complete")
- if 'ORNMBR
- QUIT
- +3 DO FREEZE^ORCMENU
- SET VALMBCK="R"
- KILL OREBUILD
- +4 FOR ORI=1:1:$LENGTH(ORNMBR)
- SET NMBR=$PIECE(ORNMBR,",",ORI)
- if NMBR
- Begin DoDot:1
- +5 SET IDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
- SET ORIFN=$PIECE(IDX,U)
- +6 if 'ORIFN
- QUIT
- if '$PIECE(ORIFN,";",2)
- SET ORIFN=+ORIFN_";1"
- +7 IF '$$VALID^ORCACT0(ORIFN,"CP",.ORERR)
- WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_ORERR
- HANG 1
- QUIT
- +8 SET ORLK=$$LOCK1^ORX2(+ORIFN)
- IF 'ORLK
- WRITE !!,$$ORDITEM^ORCACT(ORIFN)_" invalid.",!," >> "_$PIECE(ORLK,U,2)
- HANG 1
- QUIT
- +9 SET ORES(ORIFN)=""
- End DoDot:1
- if $DATA(ORQUIT)
- QUIT
- CP1 if '$ORDER(ORES(0))
- QUIT
- SET ORSIG=$SELECT($$ESIG^ORCSIGN:1,1:0)
- +1 IF 'ORSIG
- WRITE !,"Nothing completed!"
- DO UNLOCK
- HANG 1
- QUIT
- +2 WRITE !!,"Completing orders ..."
- SET ORSTOP=+$EXTRACT($$NOW^XLFDT,1,12)
- SET ORIFN=0
- +3 FOR
- SET ORIFN=$ORDER(ORES(ORIFN))
- if ORIFN'>0
- QUIT
- Begin DoDot:1
- +4 DO COMP^ORCSAVE2(ORIFN,DUZ,ORSTOP)
- DO UNLK1^ORX2(+ORIFN)
- +5 DO COMP^ORMBLDOR(ORIFN)
- End DoDot:1
- +6 SET OREBUILD=1
- CPQ QUIT