ORCSIGN ;SLC/MKB-Sign/Release orders ;10/29/01 11:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,48,79,108,110,134,215**;Dec 17, 1997
;
EN ; -- start here
I '$D(^XUSEC("ORES",DUZ)),'$D(^XUSEC("ORELSE",DUZ)),'$D(^XUSEC("OREMAS",DUZ)) W !,"Insufficient privilege!" H 1 Q
N ORPTLK,ORI,NMBR,IDX,ORIFN,ORSIG,OREL,ORNATR,ORPRNT,ORPRINT,ORCHART,ORQUIT,ORERR,ORES,ORDER,OROLDSTS,ORACT,X,OR0,ORA0,ORLAB,ORWAIT,ORDA,ORWORK,ORCCNAT,ORCL,ORLR
S ORPTLK=$$LOCK^ORX2(+ORVP) I 'ORPTLK W !!,$C(7),$P(ORPTLK,U,2) H 2 Q
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR
D FREEZE^ORCMENU S VALMBCK="R" K OREBUILD
I '$G(ORL) S ORL=$$FINDLOC S:'ORL ORL=$$LOCATION^ORCMENU1 G:ORL="^" ENQ
S ORACT=$S($D(^XUSEC("ORES",DUZ)):"ES",$D(^XUSEC("OREMAS",DUZ)):"OC",$D(^XUSEC("ORELSE",DUZ)):$$SELSIG,1:"^") G:ORACT="^" ENQ
S ORNATR=$S(ORACT="RS":$$NATURE,1:"") Q:ORNATR="^"
F ORI="LR","VBEC" S X=+$O(^DIC(9.4,"C",ORI,0)) S:X ORLR(X)=1,ORLR(ORI)=X
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR D
. S IDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),ORDER=$P(IDX,U)
. Q:'ORDER S:'$P(ORDER,";",2) ORDER=+ORDER_";1"
. S ORIFN=+ORDER,ORDA=+$P(ORDER,";",2) K ORQUIT
. D VALID Q:$G(ORQUIT) S ORES(ORDER)=""
. S X=$P($G(^OR(100,ORIFN,0)),U,14) S:$G(ORLR(X)) ORES("LAB")=1
. S:$P($G(^OR(100,ORIFN,8,ORDA,0)),U,4)=2 ORES("ES")=1
EN1 G:'$O(ORES(0)) ENQ K ORQUIT,ORWAIT
D ORDCHK^ORCMENU1 G:'$O(ORES(0)) ENQ0
I $G(ORQUIT) D UNLOCK G ENQ ;quit - ^ at override reason
S ORSIG=$S($G(ORES("ES")):2,1:3),OREL=0
I ORSIG=3 W !,"These order(s) do not require a signature."
E D I ORSIG=2,'OREL W !,"Nothing signed or released!" D UNLOCK H 2 G ENQ
. I ORACT="ES" S:$$ESIG ORSIG=1,OREL=1 Q
. I ORACT="OC" S:$$ONCHART ORSIG=0,OREL=1,ORNATR="W" Q
. I ORACT="RS" W:ORNATR'="I" !!,"A signature is required to RELEASE these orders; the responsible provider will",!,"be alerted to electronically sign them." S:$$ESIG ORSIG=$S(ORNATR="I":1,1:$$SIGSTS^ORX1(ORNATR)),OREL=1
S ORPRNT=$$GET^XPAR("ALL","ORPF PRINT CHART COPY WHEN"),ORPRINT=0
S ORCCNAT=$$CHART^ORX1($S(ORNATR="":"E",1:ORNATR)),ORCHART=0
S ORLAB=0 I '$D(^XUSEC("ORES",DUZ))!$$GET^XPAR("ALL","ORPF SHOW LAB #") S ORLAB=$G(ORLR("LR")) ;show Lab# when released
W !!,"Processing orders ..." D:$G(ORES("LAB")) BHS^ORMBLD(ORVP)
EN2 S ORDER=0 F S ORDER=$O(ORES(ORDER)) Q:ORDER'>0 D
. S OROLDSTS=$P($G(^OR(100,+ORDER,3)),U,3),OR0=$G(^(0)),ORA0=$G(^(8,+$P(ORDER,";",2),0))
. N ORNP S ORNP=$P(ORA0,U,3),ORIFN=+ORDER,ORDA=+$P(ORDER,";",2)
. S ORNATR=$S($P(ORA0,U,4)=3:"",1:ORNATR) ; reset nature of order for sig not reqd orders --added with patch 110
. D EN^ORCSEND(ORDER,,ORSIG,OREL,ORNATR,,.ORERR),UNLK1^ORX2(ORIFN)
. I $D(^TMP("ORNEW",$J,ORIFN,ORDA)) K ^(ORDA) D UNLK1^ORX2(ORIFN)
. I $G(ORERR) D S ORWAIT=1 Q
. . W !!,$$ORDITEM^ORCACT(ORDER)_" "_$$STATUS(ORDER)
. . W:$L($P($G(ORERR),U,2)) !," >> "_$P(ORERR,U,2)
. I $P(ORA0,U,2)="NW",OROLDSTS=11,$P(OR0,U,14)=ORLAB,$G(^OR(100,ORIFN,4)) W !,$$ORDITEM^ORCACT(ORIFN)_" (LB #"_+^OR(100,ORIFN,4)_")" S ORWAIT=1
. I $P(ORA0,U,2)="DC",$P(OR0,U,11)=$O(^ORD(100.98,"B","DO",0)),OROLDSTS=6 D ;dc'd active NPO
. . N ORSTRT,ORDATE S ORSTRT=+$E($P($$NOW^XLFDT,".",2)_"0000",1,4)
. . S ORDATE=DT D LTRAY^ORCDFH ;need late tray for reinstated diet?
. D SETPRINT W "."
D:$G(ORES("LAB")) BTS^ORMBLD(ORVP)
EN3 I $O(ORCHART(0))!$O(ORPRINT(0)) S ORCL=$$LOC^ORMEVNT I ORCL,ORCL'=ORL D
. N X,Y,DIR S DIR(0)="YA",DIR("B")="YES"
. S DIR("A",1)="This patient's location has been changed to "_$P($G(^SC(+ORCL,0)),U)_"."
. S DIR("A")="Should the orders be printed using the new location? "
. S DIR("?")="Enter NO to continue using "_$P($G(^SC(+ORL,0)),U)_" for ordering and printing, or YES to switch to the patient's current location instead"
. D ^DIR S:Y ORL=ORCL
D:$O(ORCHART(0)) PRINT^ORPR02(ORVP,.ORCHART,,ORL,"1^0^0^0^0")
D:$O(ORPRINT(0)) PRINT^ORPR02(ORVP,.ORPRINT,,ORL,"0^1^1^1^"_$$WORK(ORNATR))
ENQ0 D UNOTIF S OREBUILD=1
ENQ D:'$D(^TMP("ORNEW",$J)) UNLOCK^ORX2(+ORVP) D:$G(ORWAIT) READ ;output
Q
;
ESIG() ; -- Get electronic signature
N CODE,X,X1,Y
S CODE=$P($G(^VA(200,DUZ,20)),U,4),Y=0 I '$L(CODE) D Q Y
. W $C(7),!,"You do not have an electronic signature code."
. W !,"Please contact your IRM office." ; allow to enter code here?
D SIG^XUSESIG S Y=(X1'="")
Q Y
;
ONCHART() ; -- Signed on Chart?
N X,Y,DIR S DIR(0)="YA"
S DIR("B")=$S($$GET^XPAR("ALL","OR SIGNED ON CHART"):"YES",1:"NO")
S DIR("A")="Are you sure you want to mark these orders as already Signed on Chart? "
S DIR("?")="Enter YES only if these orders have already been signed in the patient's paper chart"
D ^DIR S:$D(DTOUT)!($D(DUOUT)) Y="^"
Q Y
;
SELSIG() ; -- Select type of signature &/or release [ORELSE holders only]
N X,Y,DIR,ES,ELSE
D CKAUTH(.ES,.ELSE) I ES,'ELSE Q "ES" ;all may be elec signed
S DIR("A")="Sign or release: ",DIR(0)="SAOM^"_$S($G(ES):"ES:Electronic Signature;",1:"")_"OC:Signed on Chart;RS:Release w/o MD Signature"
S DIR("B")=$S($G(ES):"Electronic Signature",$$GET^XPAR("ALL","OR SIGNATURE DEFAULT ACTION")="OC":"Signed on Chart",1:"Release w/o MD Signature")
S:$G(ES) DIR("?",1)="To electronically sign those orders that you are priviledged to, select ES."
S DIR("?")="If these orders have already been signed on the paper chart, select OC. To simply release these orders to the appropriate service for action, select RS; the requesting clinician will receive an alert to sign them."
W !!,$S($G(ES):" ES Electronic Signature ",1:"")_" OC Signed on Chart RS Release w/o MD Signature",!
D ^DIR S:$D(DTOUT)!($D(DUOUT))!(X="") Y="^"
Q Y
;
CKAUTH(SIGN,NOT) ; -- Ck authorization needed
N I,N,IFN,ACT S (SIGN,NOT)=0
F I=1:1:$L(ORNMBR,",") S N=$P(ORNMBR,",",I) I N D
. S IFN=$P($G(^TMP("OR",$J,ORTAB,"IDX",N)),U) Q:'IFN
. S ACT=$P(IFN,";",2),IFN=+IFN S:ACT'>0 ACT=1
. I $P($G(^OR(100,IFN,0)),U,16)<2 S SIGN=SIGN+1
. E S NOT=NOT+1
Q
;
NATURE() ; -- Returns nature of order/activity
N X,Y,DIR S DIR("A")="NATURE OF ORDER ACTIVITY: "
S DIR("B")=$S($G(ORNP)=DUZ:"Policy",1:"Verbal")
S DIR(0)="SAM^V:Verbal;T:Telephoned;P:Policy;"
S DIR("?")="Enter how this order was requested or originated."
D ^DIR S:$D(DTOUT)!($D(DUOUT)) Y="^" S:Y="P" Y="I" S:Y="T" Y="P"
Q Y
;
SETPRINT ; -- Set print arrays
I $P(^OR(100,ORIFN,3),U,3)=10 Q ; Still delayed
N Y S Y=$S($P(ORA0,U,15)=10:1,$P(ORA0,U,15)=11:1,1:0)
S:Y ORPRINT=ORPRINT+1,ORPRINT(ORPRINT)=ORDER
I ("R"[ORPRNT&Y)!(ORPRNT="S"&(ORSIG'=2)),ORCCNAT S ORCHART=ORCHART+1,ORCHART(ORCHART)=ORDER
Q
;
WORK(NATR) ; -- Returns 1 or 0, to print work copies for NATR
S:$G(NATR)="" NATR="E" S:'NATR NATR=+$O(^ORD(100.02,"C",NATR,0))
Q +$P($G(^ORD(100.02,NATR,1)),U,5)
;
CHART ; -- Trigger chart signature notification
N ORB S ORB=+ORVP_U_+ORIFN_U_ORNP_"^^1"
D EN^OCXOERR(ORB)
Q
;
NOTIF ; -- Trigger unsigned orders notification
N ORB S ORB=+ORVP_U_+ORIFN_U_ORNP_"^^^^^1"
D EN^OCXOERR(ORB)
Q
;
UNOTIF ; -- Undo unsigned orders notification
Q:$O(^OR(100,"AS",ORVP,0)) ; more left
N XQAKILL,ORNIFN
S ORNIFN=$O(^ORD(100.9,"B","ORDER REQUIRES ELEC SIGNATURE",0))
S XQAKILL=$$XQAKILL^ORB3F1(ORNIFN) ; unsigned orders notif
I $D(XQAID),$P($P(XQAID,";"),",",3)=ORNIFN D DELETE^XQALERT
I '$D(XQAID) S XQAID=$P($G(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN D DELETEA^XQALERT K XQAID
Q
;
VALID ; -- validate ORDER for signature/release
N ORLK,ORDIALOG,OROUT,ORPKG
I '$$VALID^ORCACT0(ORDER,ORACT,.ORERR,ORNATR) W !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!," >> "_ORERR S (ORQUIT,ORWAIT)=1 Q
S ORLK=$$LOCK1^ORX2(ORIFN) I 'ORLK W !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!," >> "_$P(ORLK,U,2) S (ORQUIT,ORWAIT)=1 Q ;order locked
S ORDIALOG=+$P(^OR(100,ORIFN,0),U,5),ORPKG=+$P(^(0),U,14)
I $P($G(^OR(100,ORIFN,8,ORDA,0)),U,15)'=11,ORPKG'=$$PKG^ORMPS1("PSO") Q
S OROUT=$$MSG^ORXD(ORDIALOG) I OROUT W !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!," >> "_$P(OROUT,U,2) S (ORQUIT,ORWAIT)=1 Q ;dlg out of order
I ORDA'>1,$L($G(^ORD(101.41,ORDIALOG,7))) X ^(7) ;validate new orders
Q
;
UNLOCK ; -- Unlock orders in ORES(ORDER)
N ORIFN S ORIFN=0
F S ORIFN=$O(ORES(ORIFN)) Q:ORIFN'>0 D UNLK1^ORX2(+ORIFN)
Q
;
STATUS(ORD) ; -- return [release] status of order ORD
N STS,X,Y S STS=$P($G(^OR(100,+ORD,8,+$P(ORD,";",2),0)),U,15)
I STS S Y=$S(STS=10:"delayed",STS=11:"not released",STS=13:"cancelled",1:"")
E S X=$P($G(^OR(100,+ORD,3)),U,3),X=$P($G(^ORD(100.01,+X,0)),U),Y=$$LOW^XLFSTR(X)
Q Y
;
READ ; -- Press return to continue
N X,Y,DIR
S DIR(0)="EA",DIR("A")="Press <return> to continue ..."
D ^DIR
Q
;
FINDLOC() ; -- Determine location from selected orders
N ORI,ORN,ORIFN,ORX,ORY S ORY=""
F ORI=1:1:$L(ORNMBR,",") S ORN=+$P(ORNMBR,",",ORI) I ORN D Q:ORY="^"
. S ORIFN=+$G(^TMP("OR",$J,ORTAB,"IDX",ORN)) Q:'ORIFN
. S ORX=$P($G(^OR(100,ORIFN,0)),U,10) Q:'ORX S:ORY="" ORY=ORX
. I ORY'="",ORY'=ORX S ORY="^" Q ;different loc's -> prompt
Q ORY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCSIGN 9019 printed Oct 16, 2024@18:29:40 Page 2
ORCSIGN ;SLC/MKB-Sign/Release orders ;10/29/01 11:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,56,48,79,108,110,134,215**;Dec 17, 1997
+2 ;
EN ; -- start here
+1 IF '$DATA(^XUSEC("ORES",DUZ))
IF '$DATA(^XUSEC("ORELSE",DUZ))
IF '$DATA(^XUSEC("OREMAS",DUZ))
WRITE !,"Insufficient privilege!"
HANG 1
QUIT
+2 NEW ORPTLK,ORI,NMBR,IDX,ORIFN,ORSIG,OREL,ORNATR,ORPRNT,ORPRINT,ORCHART,ORQUIT,ORERR,ORES,ORDER,OROLDSTS,ORACT,X,OR0,ORA0,ORLAB,ORWAIT,ORDA,ORWORK,ORCCNAT,ORCL,ORLR
+3 SET ORPTLK=$$LOCK^ORX2(+ORVP)
IF 'ORPTLK
WRITE !!,$CHAR(7),$PIECE(ORPTLK,U,2)
HANG 2
QUIT
+4 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("")
if 'ORNMBR
QUIT
+5 DO FREEZE^ORCMENU
SET VALMBCK="R"
KILL OREBUILD
+6 IF '$GET(ORL)
SET ORL=$$FINDLOC
if 'ORL
SET ORL=$$LOCATION^ORCMENU1
if ORL="^"
GOTO ENQ
+7 SET ORACT=$SELECT($DATA(^XUSEC("ORES",DUZ)):"ES",$DATA(^XUSEC("OREMAS",DUZ)):"OC",$DATA(^XUSEC("ORELSE",DUZ)):$$SELSIG,1:"^")
if ORACT="^"
GOTO ENQ
+8 SET ORNATR=$SELECT(ORACT="RS":$$NATURE,1:"")
if ORNATR="^"
QUIT
+9 FOR ORI="LR","VBEC"
SET X=+$ORDER(^DIC(9.4,"C",ORI,0))
if X
SET ORLR(X)=1
SET ORLR(ORI)=X
+10 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
IF NMBR
Begin DoDot:1
+11 SET IDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
SET ORDER=$PIECE(IDX,U)
+12 if 'ORDER
QUIT
if '$PIECE(ORDER,";",2)
SET ORDER=+ORDER_";1"
+13 SET ORIFN=+ORDER
SET ORDA=+$PIECE(ORDER,";",2)
KILL ORQUIT
+14 DO VALID
if $GET(ORQUIT)
QUIT
SET ORES(ORDER)=""
+15 SET X=$PIECE($GET(^OR(100,ORIFN,0)),U,14)
if $GET(ORLR(X))
SET ORES("LAB")=1
+16 if $PIECE($GET(^OR(100,ORIFN,8,ORDA,0)),U,4)=2
SET ORES("ES")=1
End DoDot:1
EN1 if '$ORDER(ORES(0))
GOTO ENQ
KILL ORQUIT,ORWAIT
+1 DO ORDCHK^ORCMENU1
if '$ORDER(ORES(0))
GOTO ENQ0
+2 ;quit - ^ at override reason
IF $GET(ORQUIT)
DO UNLOCK
GOTO ENQ
+3 SET ORSIG=$SELECT($GET(ORES("ES")):2,1:3)
SET OREL=0
+4 IF ORSIG=3
WRITE !,"These order(s) do not require a signature."
+5 IF '$TEST
Begin DoDot:1
+6 IF ORACT="ES"
if $$ESIG
SET ORSIG=1
SET OREL=1
QUIT
+7 IF ORACT="OC"
if $$ONCHART
SET ORSIG=0
SET OREL=1
SET ORNATR="W"
QUIT
+8 IF ORACT="RS"
if ORNATR'="I"
WRITE !!,"A signature is required to RELEASE these orders; the responsible provider will",!,"be alerted to electronically sign them."
if $$ESIG
SET ORSIG=$SELECT(ORNATR="I":1,1:$$SIGSTS^ORX1(ORNATR))
SET OREL=1
End DoDot:1
IF ORSIG=2
IF 'OREL
WRITE !,"Nothing signed or released!"
DO UNLOCK
HANG 2
GOTO ENQ
+9 SET ORPRNT=$$GET^XPAR("ALL","ORPF PRINT CHART COPY WHEN")
SET ORPRINT=0
+10 SET ORCCNAT=$$CHART^ORX1($SELECT(ORNATR="":"E",1:ORNATR))
SET ORCHART=0
+11 ;show Lab# when released
SET ORLAB=0
IF '$DATA(^XUSEC("ORES",DUZ))!$$GET^XPAR("ALL","ORPF SHOW LAB #")
SET ORLAB=$GET(ORLR("LR"))
+12 WRITE !!,"Processing orders ..."
if $GET(ORES("LAB"))
DO BHS^ORMBLD(ORVP)
EN2 SET ORDER=0
FOR
SET ORDER=$ORDER(ORES(ORDER))
if ORDER'>0
QUIT
Begin DoDot:1
+1 SET OROLDSTS=$PIECE($GET(^OR(100,+ORDER,3)),U,3)
SET OR0=$GET(^(0))
SET ORA0=$GET(^(8,+$PIECE(ORDER,";",2),0))
+2 NEW ORNP
SET ORNP=$PIECE(ORA0,U,3)
SET ORIFN=+ORDER
SET ORDA=+$PIECE(ORDER,";",2)
+3 ; reset nature of order for sig not reqd orders --added with patch 110
SET ORNATR=$SELECT($PIECE(ORA0,U,4)=3:"",1:ORNATR)
+4 DO EN^ORCSEND(ORDER,,ORSIG,OREL,ORNATR,,.ORERR)
DO UNLK1^ORX2(ORIFN)
+5 IF $DATA(^TMP("ORNEW",$JOB,ORIFN,ORDA))
KILL ^(ORDA)
DO UNLK1^ORX2(ORIFN)
+6 IF $GET(ORERR)
Begin DoDot:2
+7 WRITE !!,$$ORDITEM^ORCACT(ORDER)_" "_$$STATUS(ORDER)
+8 if $LENGTH($PIECE($GET(ORERR),U,2))
WRITE !," >> "_$PIECE(ORERR,U,2)
End DoDot:2
SET ORWAIT=1
QUIT
+9 IF $PIECE(ORA0,U,2)="NW"
IF OROLDSTS=11
IF $PIECE(OR0,U,14)=ORLAB
IF $GET(^OR(100,ORIFN,4))
WRITE !,$$ORDITEM^ORCACT(ORIFN)_" (LB #"_+^OR(100,ORIFN,4)_")"
SET ORWAIT=1
+10 ;dc'd active NPO
IF $PIECE(ORA0,U,2)="DC"
IF $PIECE(OR0,U,11)=$ORDER(^ORD(100.98,"B","DO",0))
IF OROLDSTS=6
Begin DoDot:2
+11 NEW ORSTRT,ORDATE
SET ORSTRT=+$EXTRACT($PIECE($$NOW^XLFDT,".",2)_"0000",1,4)
+12 ;need late tray for reinstated diet?
SET ORDATE=DT
DO LTRAY^ORCDFH
End DoDot:2
+13 DO SETPRINT
WRITE "."
End DoDot:1
+14 if $GET(ORES("LAB"))
DO BTS^ORMBLD(ORVP)
EN3 IF $ORDER(ORCHART(0))!$ORDER(ORPRINT(0))
SET ORCL=$$LOC^ORMEVNT
IF ORCL
IF ORCL'=ORL
Begin DoDot:1
+1 NEW X,Y,DIR
SET DIR(0)="YA"
SET DIR("B")="YES"
+2 SET DIR("A",1)="This patient's location has been changed to "_$PIECE($GET(^SC(+ORCL,0)),U)_"."
+3 SET DIR("A")="Should the orders be printed using the new location? "
+4 SET DIR("?")="Enter NO to continue using "_$PIECE($GET(^SC(+ORL,0)),U)_" for ordering and printing, or YES to switch to the patient's current location instead"
+5 DO ^DIR
if Y
SET ORL=ORCL
End DoDot:1
+6 if $ORDER(ORCHART(0))
DO PRINT^ORPR02(ORVP,.ORCHART,,ORL,"1^0^0^0^0")
+7 if $ORDER(ORPRINT(0))
DO PRINT^ORPR02(ORVP,.ORPRINT,,ORL,"0^1^1^1^"_$$WORK(ORNATR))
ENQ0 DO UNOTIF
SET OREBUILD=1
ENQ ;output
if '$DATA(^TMP("ORNEW",$JOB))
DO UNLOCK^ORX2(+ORVP)
if $GET(ORWAIT)
DO READ
+1 QUIT
+2 ;
ESIG() ; -- Get electronic signature
+1 NEW CODE,X,X1,Y
+2 SET CODE=$PIECE($GET(^VA(200,DUZ,20)),U,4)
SET Y=0
IF '$LENGTH(CODE)
Begin DoDot:1
+3 WRITE $CHAR(7),!,"You do not have an electronic signature code."
+4 ; allow to enter code here?
WRITE !,"Please contact your IRM office."
End DoDot:1
QUIT Y
+5 DO SIG^XUSESIG
SET Y=(X1'="")
+6 QUIT Y
+7 ;
ONCHART() ; -- Signed on Chart?
+1 NEW X,Y,DIR
SET DIR(0)="YA"
+2 SET DIR("B")=$SELECT($$GET^XPAR("ALL","OR SIGNED ON CHART"):"YES",1:"NO")
+3 SET DIR("A")="Are you sure you want to mark these orders as already Signed on Chart? "
+4 SET DIR("?")="Enter YES only if these orders have already been signed in the patient's paper chart"
+5 DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET Y="^"
+6 QUIT Y
+7 ;
SELSIG() ; -- Select type of signature &/or release [ORELSE holders only]
+1 NEW X,Y,DIR,ES,ELSE
+2 ;all may be elec signed
DO CKAUTH(.ES,.ELSE)
IF ES
IF 'ELSE
QUIT "ES"
+3 SET DIR("A")="Sign or release: "
SET DIR(0)="SAOM^"_$SELECT($GET(ES):"ES:Electronic Signature;",1:"")_"OC:Signed on Chart;RS:Release w/o MD Signature"
+4 SET DIR("B")=$SELECT($GET(ES):"Electronic Signature",$$GET^XPAR("ALL","OR SIGNATURE DEFAULT ACTION")="OC":"Signed on Chart",1:"Release w/o MD Signature")
+5 if $GET(ES)
SET DIR("?",1)="To electronically sign those orders that you are priviledged to, select ES."
+6 SET DIR("?")="If these orders have already been signed on the paper chart, select OC. To simply release these orders to the appropriate service for action, select RS; the requesting clinician will receive an alert to sign them."
+7 WRITE !!,$SELECT($GET(ES):" ES Electronic Signature ",1:"")_" OC Signed on Chart RS Release w/o MD Signature",!
+8 DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))!(X="")
SET Y="^"
+9 QUIT Y
+10 ;
CKAUTH(SIGN,NOT) ; -- Ck authorization needed
+1 NEW I,N,IFN,ACT
SET (SIGN,NOT)=0
+2 FOR I=1:1:$LENGTH(ORNMBR,",")
SET N=$PIECE(ORNMBR,",",I)
IF N
Begin DoDot:1
+3 SET IFN=$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",N)),U)
if 'IFN
QUIT
+4 SET ACT=$PIECE(IFN,";",2)
SET IFN=+IFN
if ACT'>0
SET ACT=1
+5 IF $PIECE($GET(^OR(100,IFN,0)),U,16)<2
SET SIGN=SIGN+1
+6 IF '$TEST
SET NOT=NOT+1
End DoDot:1
+7 QUIT
+8 ;
NATURE() ; -- Returns nature of order/activity
+1 NEW X,Y,DIR
SET DIR("A")="NATURE OF ORDER ACTIVITY: "
+2 SET DIR("B")=$SELECT($GET(ORNP)=DUZ:"Policy",1:"Verbal")
+3 SET DIR(0)="SAM^V:Verbal;T:Telephoned;P:Policy;"
+4 SET DIR("?")="Enter how this order was requested or originated."
+5 DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
SET Y="^"
if Y="P"
SET Y="I"
if Y="T"
SET Y="P"
+6 QUIT Y
+7 ;
SETPRINT ; -- Set print arrays
+1 ; Still delayed
IF $PIECE(^OR(100,ORIFN,3),U,3)=10
QUIT
+2 NEW Y
SET Y=$SELECT($PIECE(ORA0,U,15)=10:1,$PIECE(ORA0,U,15)=11:1,1:0)
+3 if Y
SET ORPRINT=ORPRINT+1
SET ORPRINT(ORPRINT)=ORDER
+4 IF ("R"[ORPRNT&Y)!(ORPRNT="S"&(ORSIG'=2))
IF ORCCNAT
SET ORCHART=ORCHART+1
SET ORCHART(ORCHART)=ORDER
+5 QUIT
+6 ;
WORK(NATR) ; -- Returns 1 or 0, to print work copies for NATR
+1 if $GET(NATR)=""
SET NATR="E"
if 'NATR
SET NATR=+$ORDER(^ORD(100.02,"C",NATR,0))
+2 QUIT +$PIECE($GET(^ORD(100.02,NATR,1)),U,5)
+3 ;
CHART ; -- Trigger chart signature notification
+1 NEW ORB
SET ORB=+ORVP_U_+ORIFN_U_ORNP_"^^1"
+2 DO EN^OCXOERR(ORB)
+3 QUIT
+4 ;
NOTIF ; -- Trigger unsigned orders notification
+1 NEW ORB
SET ORB=+ORVP_U_+ORIFN_U_ORNP_"^^^^^1"
+2 DO EN^OCXOERR(ORB)
+3 QUIT
+4 ;
UNOTIF ; -- Undo unsigned orders notification
+1 ; more left
if $ORDER(^OR(100,"AS",ORVP,0))
QUIT
+2 NEW XQAKILL,ORNIFN
+3 SET ORNIFN=$ORDER(^ORD(100.9,"B","ORDER REQUIRES ELEC SIGNATURE",0))
+4 ; unsigned orders notif
SET XQAKILL=$$XQAKILL^ORB3F1(ORNIFN)
+5 IF $DATA(XQAID)
IF $PIECE($PIECE(XQAID,";"),",",3)=ORNIFN
DO DELETE^XQALERT
+6 IF '$DATA(XQAID)
SET XQAID=$PIECE($GET(^ORD(100.9,ORNIFN,0)),U,2)_","_+ORVP_","_ORNIFN
DO DELETEA^XQALERT
KILL XQAID
+7 QUIT
+8 ;
VALID ; -- validate ORDER for signature/release
+1 NEW ORLK,ORDIALOG,OROUT,ORPKG
+2 IF '$$VALID^ORCACT0(ORDER,ORACT,.ORERR,ORNATR)
WRITE !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!," >> "_ORERR
SET (ORQUIT,ORWAIT)=1
QUIT
+3 ;order locked
SET ORLK=$$LOCK1^ORX2(ORIFN)
IF 'ORLK
WRITE !!,"Cannot sign "_$$ORDITEM^ORCACT(ORDER),!," >> "_$PIECE(ORLK,U,2)
SET (ORQUIT,ORWAIT)=1
QUIT
+4 SET ORDIALOG=+$PIECE(^OR(100,ORIFN,0),U,5)
SET ORPKG=+$PIECE(^(0),U,14)
+5 IF $PIECE($GET(^OR(100,ORIFN,8,ORDA,0)),U,15)'=11
IF ORPKG'=$$PKG^ORMPS1("PSO")
QUIT
+6 ;dlg out of order
SET OROUT=$$MSG^ORXD(ORDIALOG)
IF OROUT
WRITE !!,"Cannot release "_$$ORDITEM^ORCACT(ORDER),!," >> "_$PIECE(OROUT,U,2)
SET (ORQUIT,ORWAIT)=1
QUIT
+7 ;validate new orders
IF ORDA'>1
IF $LENGTH($GET(^ORD(101.41,ORDIALOG,7)))
XECUTE ^(7)
+8 QUIT
+9 ;
UNLOCK ; -- Unlock orders in ORES(ORDER)
+1 NEW ORIFN
SET ORIFN=0
+2 FOR
SET ORIFN=$ORDER(ORES(ORIFN))
if ORIFN'>0
QUIT
DO UNLK1^ORX2(+ORIFN)
+3 QUIT
+4 ;
STATUS(ORD) ; -- return [release] status of order ORD
+1 NEW STS,X,Y
SET STS=$PIECE($GET(^OR(100,+ORD,8,+$PIECE(ORD,";",2),0)),U,15)
+2 IF STS
SET Y=$SELECT(STS=10:"delayed",STS=11:"not released",STS=13:"cancelled",1:"")
+3 IF '$TEST
SET X=$PIECE($GET(^OR(100,+ORD,3)),U,3)
SET X=$PIECE($GET(^ORD(100.01,+X,0)),U)
SET Y=$$LOW^XLFSTR(X)
+4 QUIT Y
+5 ;
READ ; -- Press return to continue
+1 NEW X,Y,DIR
+2 SET DIR(0)="EA"
SET DIR("A")="Press <return> to continue ..."
+3 DO ^DIR
+4 QUIT
+5 ;
FINDLOC() ; -- Determine location from selected orders
+1 NEW ORI,ORN,ORIFN,ORX,ORY
SET ORY=""
+2 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET ORN=+$PIECE(ORNMBR,",",ORI)
IF ORN
Begin DoDot:1
+3 SET ORIFN=+$GET(^TMP("OR",$JOB,ORTAB,"IDX",ORN))
if 'ORIFN
QUIT
+4 SET ORX=$PIECE($GET(^OR(100,ORIFN,0)),U,10)
if 'ORX
QUIT
if ORY=""
SET ORY=ORX
+5 ;different loc's -> prompt
IF ORY'=""
IF ORY'=ORX
SET ORY="^"
QUIT
End DoDot:1
if ORY="^"
QUIT
+6 QUIT ORY
