Index: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMGMRC.m
===================================================================
--- WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMGMRC.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMGMRC.m	(revision 623)
@@ -1,158 +1,158 @@
-ORMGMRC	; SLC/MKB - Process Consult ORM msgs ;12/13/2006
-	;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,26,68,92,153,174,195,255,243**;Dec 17, 1997;Build 242
-EN	; -- entry point for GMRC messges
-	I '$L($T(@ORDCNTRL)) Q  ;S ORERR="Invalid order control code" Q
-	I ORDCNTRL'="SN",ORDCNTRL'="ZP",'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q
-	S:ORDCNTRL="OC"&(ORTYPE="ORR") ORDCNTRL="UA" ;new code
-	N ORSTS,OREASON1,NTE S ORSTS=$$STATUS(ORDSTS)
-	S:'ORLOG ORLOG=$$NOW^XLFDT S:'ORDUZ ORDUZ=DUZ S:$G(DGPMT) ORDUZ=""
-	S OREASON=$P(OREASON,U,5),NTE=$O(@ORMSG@(+ORC)),OREASON1=""
-	I NTE,$E(@ORMSG@(NTE),1,3)="NTE" S OREASON1=$P(@ORMSG@(NTE),"|",4)
-	D @ORDCNTRL
-	Q
-	;
-ZP	; -- Purged
-	Q:'ORIFN  Q:'$D(^OR(100,+ORIFN,0))
-	K ^OR(100,+ORIFN,4) I "^3^5^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,14) ; Remove pkg reference, sts=lapsed if still active
-	Q
-	;
-ZR	; -- Purged as requested [ack]
-	D DELETE^ORCSAVE2(+ORIFN)
-	Q
-	;
-ZU	; -- Unable to purge [ack]
-	S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity
-	Q
-	;
-OK	; -- Order accepted, GMRC order # assigned [ack]
-	S ^OR(100,+ORIFN,4)=PKGIFN S:'$G(ORSTS) ORSTS=5
-	D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 5=pending
-	D DATES^ORCSAVE2(+ORIFN,+$E($$NOW^XLFDT,1,12))
-	Q
-	;
-XX	; -- Change order
-	N ORDIALOG,ORDG,ORDA,ORX,ORP,ORSIG S:'$L(ORNATR) ORNATR="S"
-	D DLG Q:$D(ORERR)  Q:'$D(ORDIALOG)  S ORIFN=+ORIFN
-	S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON1,ORLOG,ORDUZ)
-	I ORDA'>0 S ORERR="Cannot create new order action" Q
-	; -Update sts of order to active, last action to dc/edit:
-	S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) S:ORX'>0 ORX=+$O(^(8,ORDA),-1)
-	I $D(^OR(100,ORIFN,8,ORX,0)),$P(^(0),U,15)="" S $P(^(0),U,15)=12
-	S $P(^OR(100,ORIFN,3),U,7)=ORDA D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS)
-	D PXRMKILL^ORDD100(ORIFN,ORVP,ORLOG) ; JEH 255
-	D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
-	; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd
-	S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
-	D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG
-	; -Update responses, get/save new order text:
-	K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
-	S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA
-	K:OREASON="RESUBMIT" ^OR(100,ORIFN,6) ;clear previous DC data
-	D PXRMADD^ORDD100(ORIFN,ORVP,ORLOG) ; JEH 255
-	I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
-	Q
-	;
-SN	; -- New backdoor order: return NA msg w/ORIFN, or DE msg
-	N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W"
-	I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q
-	I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q
-	I '$G(ORL) S ORERR="Missing or invalid patient location" Q
-	D DLG Q:$D(ORERR)  Q:'$D(ORDIALOG)
-SN1	D EN^ORCSAVE K ^TMP("ORWORD",$J) ; setting status, xrefs
-	I '$G(ORIFN) S ORERR="Cannot create new order" Q
-	;Save DG1 and ZCL segments of HL7 message from backdoor orders
-	D BDOSTR^ORWDBA3
-	D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1)
-	S:'ORSTRT ORSTRT=$$NOW^XLFDT D DATES^ORCSAVE2(+ORIFN,ORSTRT)
-	D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS)
-	I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy
-	S ^OR(100,ORIFN,4)=PKGIFN
-	Q
-	;
-DLG	; -- Build ORDIALOG(),ORDG from msg
-	N OBR,USID,TYPE,OI,ZSV,J,OBX,WP,I
-	S OBR=$$OBR I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q
-	S USID=$P(@ORMSG@(OBR),"|",5),TYPE=$S(USID["99CON":"CONSULT",1:"REQUEST")
-	S ORDIALOG=$O(^ORD(101.41,"AB","GMRCOR "_TYPE,0))
-	D GETDLG1^ORCD(ORDIALOG)
-	S ORDIALOG($$PTR("URGENCY"),1)=ORURG
-	S OI=$$ORDITEM^ORM(USID) I 'OI S ORERR="Invalid consult or procedure" Q
-	S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
-	S ZSV=$O(@ORMSG@(OBR)) I ZSV,$E(@ORMSG@(ZSV),1,3)="ZSV" D
-	. N X1,X2 S X1=$P(@ORMSG@(ZSV),"|",2),X2=$P(@ORMSG@(ZSV),"|",3)
-	. I TYPE="REQUEST" S ORDIALOG($$PTR("REQUEST SERVICE"),1)=+$P(X1,U,4)
-	. I TYPE="CONSULT",$L(X2) S ORDIALOG($$PTR("FREE TEXT OI"),1)=X2
-D1	S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT)
-	S J=$P(@ORMSG@(OBR),"|",19),ORDIALOG($$PTR("PLACE OF CONSULTATION"),1)=$S(J="OC":"C",1:J)
-	S ORDIALOG($$PTR("PROVIDER"),1)=$P(@ORMSG@(OBR),"|",20)
-	S OBX=OBR F  S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0  S J=$E(@ORMSG@(OBX),1,3) Q:J="ORC"  Q:J="MSH"  I J="OBX" D
-	. N SEG,NAME,VALUE S SEG=@ORMSG@(OBX)
-	. S NAME=$$UP^XLFSTR($P($P(SEG,"|",4),U,2)),VALUE=$P(SEG,"|",6)
-	. I NAME="PROVISIONAL DIAGNOSIS" D  Q
-	.. S:$P(SEG,"|",3)="CE" ORDIALOG($$PTR("CODE"),1)=$P(VALUE,U),VALUE=$P(VALUE,U,2)
-	.. S ORDIALOG($$PTR("FREE TEXT"),1)=VALUE
-	. S WP=$$PTR("WORD PROCESSING 1"),I=1,^TMP("ORWORD",$J,WP,1,I,0)=VALUE
-	. S J=0 F  S J=$O(@ORMSG@(OBX,J)) Q:J'>0  S I=I+1,^TMP("ORWORD",$J,WP,1,I,0)=@ORMSG@(OBX,J)
-	S:$G(I) ^TMP("ORWORD",$J,WP,1,0)="^^"_I_U_I_U_DT_U,ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)"
-	Q
-	;
-OBR()	; -- Return subscript of RXE segment
-	N X,I,SEG S X="",I=+ORC
-	F  S I=$O(@ORMSG@(I)) Q:I'>0  S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC"  I SEG="OBR" S X=I Q
-	Q X
-	;
-SC	; -- Status changed (i.e. scheduled)
-	S:'$G(ORSTS) ORSTS=6 D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 6=active
-	Q
-	;
-STATUS(X)	; -- Returns ptr to Order Status file #100.01
-	Q $S(X="DC":1,X="CM":2,X="HD":3,X="IP":5,X="SC":6,X="A":9,X="RP":12,X="CA":13,X="ZC":8,1:5)
-	;
-RE	; -- Completed, w/results
-	N I,SEG,DA,DR,DIE,X,Y
-	S:'$G(ORSTS) ORSTS=2 D STATUS^ORCSAVE2(+ORIFN,ORSTS)
-	S X="",DA=+ORIFN,DIE="^OR(100,"
-	S DR="71////"_+$E($$NOW^XLFDT,1,12) D ^DIE
-	S I=+ORC,X="" F  S I=$O(@ORMSG@(I)) Q:I<1  S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)="ORC"  I $E(SEG,1,3)="OBX",$P(SEG,"|",4)["SIG FINDINGS" S X=$P(SEG,"|",6) Q
-	S $P(^OR(100,DA,7),U,2)=$S(X="Y":1,1:"")
-	S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4)
-	I $P(ORC,"|",17)["MAINTENANCE" Q  ;group update - no CM ack needed
-	I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov
-	Q
-	;
-UA	; -- Unable to Accept [ack]
-	S ORDUZ="" I '$L(OREASON1),$L(OREASON) S OREASON1=OREASON
-OC	; -- Cancelled/Denied
-	S:'$L(ORNATR) ORNATR="X" ;Rejected
-	S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_ORDUZ_U_ORLOG_U_U_OREASON1
-	D STATUS^ORCSAVE2(+ORIFN,13) I ORDCNTRL="OC" D UPDATE("DC") Q
-UD	; -- Unable to discontinue [ack]
-	N DA S DA=$P(ORIFN,";",2) I DA D
-	. S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected
-	. S:$L(OREASON1) ^OR(100,+ORIFN,8,DA,1)=OREASON1
-	Q
-	;
-OD	; -- Discontinued
-	S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON1
-	D STATUS^ORCSAVE2(+ORIFN,1),UPDATE("DC"):$L(ORNATR)
-	Q
-	;
-DR	; -- Discontinued [ack]
-	D STATUS^ORCSAVE2(+ORIFN,1)
-	Q
-	;
-UPDATE(ORACT)	; -- continue processing
-	N ORX,ORDA,ORP
-	S ORX=$$CREATE^ORX1(ORNATR) D:ORX
-	. S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON1,ORLOG,ORDUZ)
-	. I ORDA'>0 S ORERR="Cannot create new order action" Q
-	. D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
-	. D SIGSTS^ORCSAVE2(+ORIFN,ORDA)
-	. I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
-	. S $P(^OR(100,+ORIFN,3),U,7)=ORDA
-	I 'ORX,ORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0
-	D:$G(ORACT)="DC" CANCEL^ORCSEND(+ORIFN)
-	Q
-	;
-PTR(X)	; -- Returns ptr to prompt in Order Dialog file #101.41
-	Q $O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
+ORMGMRC ; SLC/MKB - Process Consult ORM msgs ;7/14/04 13:29
+ ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,26,68,92,153,174,195,255**;Dec 17, 1997
+EN ; -- entry point for GMRC messges
+ I '$L($T(@ORDCNTRL)) Q  ;S ORERR="Invalid order control code" Q
+ I ORDCNTRL'="SN",ORDCNTRL'="ZP",'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q
+ S:ORDCNTRL="OC"&(ORTYPE="ORR") ORDCNTRL="UA" ;new code
+ N ORSTS,OREASON1,NTE S ORSTS=$$STATUS(ORDSTS)
+ S:'ORLOG ORLOG=$$NOW^XLFDT S:'ORDUZ ORDUZ=DUZ S:$G(DGPMT) ORDUZ=""
+ S OREASON=$P(OREASON,U,5),NTE=$O(@ORMSG@(+ORC)),OREASON1=""
+ I NTE,$E(@ORMSG@(NTE),1,3)="NTE" S OREASON1=$P(@ORMSG@(NTE),"|",4)
+ D @ORDCNTRL
+ Q
+ ;
+ZP ; -- Purged
+ Q:'ORIFN  Q:'$D(^OR(100,+ORIFN,0))
+ K ^OR(100,+ORIFN,4) I "^3^5^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,14) ; Remove pkg reference, sts=lapsed if still active
+ Q
+ ;
+ZR ; -- Purged as requested [ack]
+ D DELETE^ORCSAVE2(+ORIFN)
+ Q
+ ;
+ZU ; -- Unable to purge [ack]
+ S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity
+ Q
+ ;
+OK ; -- Order accepted, GMRC order # assigned [ack]
+ S ^OR(100,+ORIFN,4)=PKGIFN S:'$G(ORSTS) ORSTS=5
+ D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 5=pending
+ D DATES^ORCSAVE2(+ORIFN,+$E($$NOW^XLFDT,1,12))
+ Q
+ ;
+XX ; -- Change order
+ N ORDIALOG,ORDG,ORDA,ORX,ORP,ORSIG S:'$L(ORNATR) ORNATR="S"
+ D DLG Q:$D(ORERR)  Q:'$D(ORDIALOG)  S ORIFN=+ORIFN
+ S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON1,ORLOG,ORDUZ)
+ I ORDA'>0 S ORERR="Cannot create new order action" Q
+ ; -Update sts of order to active, last action to dc/edit:
+ S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) S:ORX'>0 ORX=+$O(^(8,ORDA),-1)
+ I $D(^OR(100,ORIFN,8,ORX,0)),$P(^(0),U,15)="" S $P(^(0),U,15)=12
+ S $P(^OR(100,ORIFN,3),U,7)=ORDA D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS)
+ D PXRMKILL^ORDD100(ORIFN,ORVP,ORLOG)   ; JEH 255
+ D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
+ ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd
+ S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
+ D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG
+ ; -Update responses, get/save new order text:
+ K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
+ S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA
+ K:OREASON="RESUBMIT" ^OR(100,ORIFN,6) ;clear previous DC data
+ D PXRMADD^ORDD100(ORIFN,ORVP,ORLOG)   ; JEH 255
+ I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
+ Q
+ ;
+SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg
+ N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W"
+ I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q
+ I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q
+ I '$G(ORL) S ORERR="Missing or invalid patient location" Q
+ D DLG Q:$D(ORERR)  Q:'$D(ORDIALOG)
+SN1 D EN^ORCSAVE K ^TMP("ORWORD",$J) ; setting status, xrefs
+ I '$G(ORIFN) S ORERR="Cannot create new order" Q
+ ;Save DG1 and ZCL segments of HL7 message from backdoor orders
+ D BDOSTR^ORWDBA3
+ D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1)
+ S:'ORSTRT ORSTRT=$$NOW^XLFDT D DATES^ORCSAVE2(+ORIFN,ORSTRT)
+ D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS)
+ I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy
+ S ^OR(100,ORIFN,4)=PKGIFN
+ Q
+ ;
+DLG ; -- Build ORDIALOG(),ORDG from msg
+ N OBR,USID,TYPE,OI,ZSV,J,OBX,WP,I
+ S OBR=$$OBR I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q
+ S USID=$P(@ORMSG@(OBR),"|",5),TYPE=$S(USID["99CON":"CONSULT",1:"REQUEST")
+ S ORDIALOG=$O(^ORD(101.41,"AB","GMRCOR "_TYPE,0))
+ D GETDLG1^ORCD(ORDIALOG)
+ S ORDIALOG($$PTR("URGENCY"),1)=ORURG
+ S OI=$$ORDITEM^ORM(USID) I 'OI S ORERR="Invalid consult or procedure" Q
+ S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
+ S ZSV=$O(@ORMSG@(OBR)) I ZSV,$E(@ORMSG@(ZSV),1,3)="ZSV" D
+ . N X1,X2 S X1=$P(@ORMSG@(ZSV),"|",2),X2=$P(@ORMSG@(ZSV),"|",3)
+ . I TYPE="REQUEST" S ORDIALOG($$PTR("REQUEST SERVICE"),1)=+$P(X1,U,4)
+ . I TYPE="CONSULT",$L(X2) S ORDIALOG($$PTR("FREE TEXT OI"),1)=X2
+D1 S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT)
+ S J=$P(@ORMSG@(OBR),"|",19),ORDIALOG($$PTR("PLACE OF CONSULTATION"),1)=$S(J="OC":"C",1:J)
+ S ORDIALOG($$PTR("PROVIDER"),1)=$P(@ORMSG@(OBR),"|",20)
+ S OBX=OBR F  S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0  S J=$E(@ORMSG@(OBX),1,3) Q:J="ORC"  Q:J="MSH"  I J="OBX" D
+ . N SEG,NAME,VALUE S SEG=@ORMSG@(OBX)
+ . S NAME=$$UP^XLFSTR($P($P(SEG,"|",4),U,2)),VALUE=$P(SEG,"|",6)
+ . I NAME="PROVISIONAL DIAGNOSIS" D  Q
+ .. S:$P(SEG,"|",3)="CE" ORDIALOG($$PTR("CODE"),1)=$P(VALUE,U),VALUE=$P(VALUE,U,2)
+ .. S ORDIALOG($$PTR("FREE TEXT"),1)=VALUE
+ . S WP=$$PTR("WORD PROCESSING 1"),I=1,^TMP("ORWORD",$J,WP,1,I,0)=VALUE
+ . S J=0 F  S J=$O(@ORMSG@(OBX,J)) Q:J'>0  S I=I+1,^TMP("ORWORD",$J,WP,1,I,0)=@ORMSG@(OBX,J)
+ S:$G(I) ^TMP("ORWORD",$J,WP,1,0)="^^"_I_U_I_U_DT_U,ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)"
+ Q
+ ;
+OBR() ; -- Return subscript of RXE segment
+ N X,I,SEG S X="",I=+ORC
+ F  S I=$O(@ORMSG@(I)) Q:I'>0  S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC"  I SEG="OBR" S X=I Q
+ Q X
+ ;
+SC ; -- Status changed (i.e. scheduled)
+ S:'$G(ORSTS) ORSTS=6 D STATUS^ORCSAVE2(+ORIFN,ORSTS) ; 6=active
+ Q
+ ;
+STATUS(X) ; -- Returns ptr to Order Status file #100.01
+ Q $S(X="DC":1,X="CM":2,X="HD":3,X="IP":5,X="SC":6,X="A":9,X="RP":12,X="CA":13,X="ZC":8,1:5)
+ ;
+RE ; -- Completed, w/results
+ N I,SEG,DA,DR,DIE,X,Y
+ S:'$G(ORSTS) ORSTS=2 D STATUS^ORCSAVE2(+ORIFN,ORSTS)
+ S X="",DA=+ORIFN,DIE="^OR(100,"
+ S DR="71////"_+$E($$NOW^XLFDT,1,12) D ^DIE
+ S I=+ORC,X="" F  S I=$O(@ORMSG@(I)) Q:I<1  S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)="ORC"  I $E(SEG,1,3)="OBX",$P(SEG,"|",4)["SIG FINDINGS" S X=$P(SEG,"|",6) Q
+ S $P(^OR(100,DA,7),U,2)=$S(X="Y":1,1:"")
+ S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4)
+ I $P(ORC,"|",17)["MAINTENANCE" Q  ;group update - no CM ack needed
+ I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov
+ Q
+ ;
+UA ; -- Unable to Accept [ack]
+ S ORDUZ="" I '$L(OREASON1),$L(OREASON) S OREASON1=OREASON
+OC ; -- Cancelled/Denied
+ S:'$L(ORNATR) ORNATR="X" ;Rejected
+ S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_ORDUZ_U_ORLOG_U_U_OREASON1
+ D STATUS^ORCSAVE2(+ORIFN,13) I ORDCNTRL="OC" D UPDATE("DC") Q
+UD ; -- Unable to discontinue [ack]
+ N DA S DA=$P(ORIFN,";",2) I DA D
+ . S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected
+ . S:$L(OREASON1) ^OR(100,+ORIFN,8,DA,1)=OREASON1
+ Q
+ ;
+OD ; -- Discontinued
+ S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON1
+ D STATUS^ORCSAVE2(+ORIFN,1),UPDATE("DC"):$L(ORNATR)
+ Q
+ ;
+DR ; -- Discontinued [ack]
+ D STATUS^ORCSAVE2(+ORIFN,1)
+ Q
+ ;
+UPDATE(ORACT) ; -- continue processing
+ N ORX,ORDA,ORP
+ S ORX=$$CREATE^ORX1(ORNATR) D:ORX
+ . S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON1,ORLOG,ORDUZ)
+ . I ORDA'>0 S ORERR="Cannot create new order action" Q
+ . D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
+ . D SIGSTS^ORCSAVE2(+ORIFN,ORDA)
+ . I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
+ . S $P(^OR(100,+ORIFN,3),U,7)=ORDA
+ I 'ORX,ORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0
+ D:$G(ORACT)="DC" CANCEL^ORCSEND(+ORIFN)
+ Q
+ ;
+PTR(X) ; -- Returns ptr to prompt in Order Dialog file #101.41
+ Q $O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
