ORCONSLT ;SLC/MKB-Consult actions ;6/7/01 07:28
;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,48,68,100**;Dec 17, 1997
; External References
; DBIA 2424 Call to APIs COMMENT, DC, EDTSUB, PS, and RC in
; routine GMRCA1
; DBIA 2425 Call to CPRS^GMRCACTM
; DBIA 2395 Call to FR^GMRCAFRD
; DBIA 2901 Call to SF^GMRCASF
; DBIA 3120 Call to DIS^GMRCDIS
; DBIA 2427 Call to APIs ADDEND and ENTER in routine GMRCTIU
; DBIA 10140 Call to EN^XQORM
EN ; -- main entry point
N ORCMENU,XQORM,Y,ORFLG S VALMBCK=""
S ORNMBR=$P(XQORNOD(0),"=",2) D SELECT^ORCHART(ORNMBR)
S ORCMENU=$S($$SERVMENU:"SERVICE",1:"USER")
S XQORM=+$O(^ORD(101,"B","ORC CONSULT "_ORCMENU_" MENU",0))_";ORD(101,"
S XQORM(0)="1AD"_$S(ORCMENU="USER":"",1:"\"),XQORM("A")="Select action: ",XQORM("M")=+$P($G(^ORD(101,+XQORM,4)),U,2)
W ! D EN^XQORM G:Y'>0 ENQ
X:$D(^ORD(101,+$P(Y(1),U,2),20)) ^(20)
ENQ D DESELECT^ORCHART(ORNMBR):'$G(OREBUILD)
Q
;
EN1(ORACT) ; -- Action ORACT on consults
N ORLK,ORI,NMBR,ORQUIT,ORIDX,ID,GMRCACT,X
S VALMBCK="" Q:'$L($G(ORACT))
I '$G(ORNMBR) S ORNMBR=$$ORDERS^ORCHART("") Q:'ORNMBR N ORCMENU,ORFLG S ORCMENU=$S($$SERVMENU:"SERVICE",1:"USER")
D FREEZE^ORCMENU S VALMBCK="R"
F ORI=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",ORI) I NMBR,$L($T(@ORACT)) S ORIDX=$G(^TMP("OR",$J,ORTAB,"IDX",NMBR)) D Q:$G(ORQUIT)
. S ID=$P(ORIDX,U),X=$P(ORIDX,U,4) Q:'ID D SUBHDR^ORCACT(X)
. I (ORACT="CMMT")!(ORACT="PRNT")!(ORACT="EDITRES")!($G(ORFLG(ID))>1) D @ORACT Q
. W !,"Insufficient privilege for this service!" H 2
I $G(OREBUILD) D TAB^ORCHART(ORTAB,1) S $P(^TMP("OR",$J,"ORDERS",0),U)=""
Q
;
EDITRES ;Edit/Resubmit consult
D EDTSUB^GMRCA1(+ID) S OREBUILD=1
Q
REC ; -- Receive consult
D RC^GMRCA1(+ID) S OREBUILD=1
Q
;
SCHED ; -- Schedule consult
D RC^GMRCA1(+ID,1) S OREBUILD=1
Q
;
RR ; -- Reroute consult
D FR^GMRCAFRD(+ID) S OREBUILD=1
Q
;
CMMT ; -- Add comment to consult order
D COMMENT^GMRCA1(+ID)
Q
;
COMP ; -- Complete consult
;S GMRCACT="COMPLETE" D DC^GMRCA1(+ID)
D ENTER^GMRCTIU(+ID) S OREBUILD=1
Q
;
REMRSLT ; -- Remove Medicine Results
I '$L($T(DIS^GMRCDIS)) W !!,"This action is not available yet." H 2 Q
D DIS^GMRCDIS(+ID) S OREBUILD=1
Q
;
DC ; -- Discontinue consult
S GMRCACT="DISCONTINUE" D DC^GMRCA1(+ID,6) S OREBUILD=1
Q
;
DENY ; -- Deny consult request
S GMRCACT="DENY" D DC^GMRCA1(+ID,19) S OREBUILD=1
Q
;
FWD ; -- Forward consult request to other services
;D RR^GMRCAFWD(+ID) S OREBUILD=1
W !!,"No longer available." H 1
Q
;
PRNT ; -- Print consult form
D PS^GMRCA1(+ID)
Q
;
SIGF ; -- Significant Findings
I '$L($T(SF^GMRCASF)) W !!,"This action is not available yet." H 2 Q
D SF^GMRCASF(+ID) S OREBUILD=1
Q
;
ADDEND ; -- Make an addendum to the consult result
D ADDEND^GMRCTIU(+ID) S OREBUILD=1
Q
;
N NMBR,I,X,Y S X="",Y=0
I '$L($T(CPRS^GMRCACTM)) G SMQ
F I=1:1:$L(ORNMBR,",") S NMBR=$P(ORNMBR,",",I) I NMBR S X=X_$S($L(X):";",1:"")_+$P($G(^TMP("OR",$J,ORTAB,"IDX",NMBR)),U)
G:'$L(X) SMQ D CPRS^GMRCACTM(X) ; builds ORFLG(GMRCIEN)=<menu>
S I=0 F S I=$O(ORFLG(I)) Q:I'>0 I ORFLG(I)>1 S Y=1 Q
SMQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONSLT 3282 printed Sep 23, 2025@20:05:06 Page 2
ORCONSLT ;SLC/MKB-Consult actions ;6/7/01 07:28
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,26,48,68,100**;Dec 17, 1997
+2 ; External References
+3 ; DBIA 2424 Call to APIs COMMENT, DC, EDTSUB, PS, and RC in
+4 ; routine GMRCA1
+5 ; DBIA 2425 Call to CPRS^GMRCACTM
+6 ; DBIA 2395 Call to FR^GMRCAFRD
+7 ; DBIA 2901 Call to SF^GMRCASF
+8 ; DBIA 3120 Call to DIS^GMRCDIS
+9 ; DBIA 2427 Call to APIs ADDEND and ENTER in routine GMRCTIU
+10 ; DBIA 10140 Call to EN^XQORM
EN ; -- main entry point
+1 NEW ORCMENU,XQORM,Y,ORFLG
SET VALMBCK=""
+2 SET ORNMBR=$PIECE(XQORNOD(0),"=",2)
DO SELECT^ORCHART(ORNMBR)
+3 SET ORCMENU=$SELECT($$SERVMENU:"SERVICE",1:"USER")
+4 SET XQORM=+$ORDER(^ORD(101,"B","ORC CONSULT "_ORCMENU_" MENU",0))_";ORD(101,"
+5 SET XQORM(0)="1AD"_$SELECT(ORCMENU="USER":"",1:"\")
SET XQORM("A")="Select action: "
SET XQORM("M")=+$PIECE($GET(^ORD(101,+XQORM,4)),U,2)
+6 WRITE !
DO EN^XQORM
if Y'>0
GOTO ENQ
+7 if $DATA(^ORD(101,+$PIECE(Y(1),U,2),20))
XECUTE ^(20)
ENQ if '$GET(OREBUILD)
DO DESELECT^ORCHART(ORNMBR)
+1 QUIT
+2 ;
EN1(ORACT) ; -- Action ORACT on consults
+1 NEW ORLK,ORI,NMBR,ORQUIT,ORIDX,ID,GMRCACT,X
+2 SET VALMBCK=""
if '$LENGTH($GET(ORACT))
QUIT
+3 IF '$GET(ORNMBR)
SET ORNMBR=$$ORDERS^ORCHART("")
if 'ORNMBR
QUIT
NEW ORCMENU,ORFLG
SET ORCMENU=$SELECT($$SERVMENU:"SERVICE",1:"USER")
+4 DO FREEZE^ORCMENU
SET VALMBCK="R"
+5 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",ORI)
IF NMBR
IF $LENGTH($TEXT(@ORACT))
SET ORIDX=$GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR))
Begin DoDot:1
+6 SET ID=$PIECE(ORIDX,U)
SET X=$PIECE(ORIDX,U,4)
if 'ID
QUIT
DO SUBHDR^ORCACT(X)
+7 IF (ORACT="CMMT")!(ORACT="PRNT")!(ORACT="EDITRES")!($GET(ORFLG(ID))>1)
DO @ORACT
QUIT
+8 WRITE !,"Insufficient privilege for this service!"
HANG 2
End DoDot:1
if $GET(ORQUIT)
QUIT
+9 IF $GET(OREBUILD)
DO TAB^ORCHART(ORTAB,1)
SET $PIECE(^TMP("OR",$JOB,"ORDERS",0),U)=""
+10 QUIT
+11 ;
EDITRES ;Edit/Resubmit consult
+1 DO EDTSUB^GMRCA1(+ID)
SET OREBUILD=1
+2 QUIT
REC ; -- Receive consult
+1 DO RC^GMRCA1(+ID)
SET OREBUILD=1
+2 QUIT
+3 ;
SCHED ; -- Schedule consult
+1 DO RC^GMRCA1(+ID,1)
SET OREBUILD=1
+2 QUIT
+3 ;
RR ; -- Reroute consult
+1 DO FR^GMRCAFRD(+ID)
SET OREBUILD=1
+2 QUIT
+3 ;
CMMT ; -- Add comment to consult order
+1 DO COMMENT^GMRCA1(+ID)
+2 QUIT
+3 ;
COMP ; -- Complete consult
+1 ;S GMRCACT="COMPLETE" D DC^GMRCA1(+ID)
+2 DO ENTER^GMRCTIU(+ID)
SET OREBUILD=1
+3 QUIT
+4 ;
REMRSLT ; -- Remove Medicine Results
+1 IF '$LENGTH($TEXT(DIS^GMRCDIS))
WRITE !!,"This action is not available yet."
HANG 2
QUIT
+2 DO DIS^GMRCDIS(+ID)
SET OREBUILD=1
+3 QUIT
+4 ;
DC ; -- Discontinue consult
+1 SET GMRCACT="DISCONTINUE"
DO DC^GMRCA1(+ID,6)
SET OREBUILD=1
+2 QUIT
+3 ;
DENY ; -- Deny consult request
+1 SET GMRCACT="DENY"
DO DC^GMRCA1(+ID,19)
SET OREBUILD=1
+2 QUIT
+3 ;
FWD ; -- Forward consult request to other services
+1 ;D RR^GMRCAFWD(+ID) S OREBUILD=1
+2 WRITE !!,"No longer available."
HANG 1
+3 QUIT
+4 ;
PRNT ; -- Print consult form
+1 DO PS^GMRCA1(+ID)
+2 QUIT
+3 ;
SIGF ; -- Significant Findings
+1 IF '$LENGTH($TEXT(SF^GMRCASF))
WRITE !!,"This action is not available yet."
HANG 2
QUIT
+2 DO SF^GMRCASF(+ID)
SET OREBUILD=1
+3 QUIT
+4 ;
ADDEND ; -- Make an addendum to the consult result
+1 DO ADDEND^GMRCTIU(+ID)
SET OREBUILD=1
+2 QUIT
+3 ;
+1 NEW NMBR,I,X,Y
SET X=""
SET Y=0
+2 IF '$LENGTH($TEXT(CPRS^GMRCACTM))
GOTO SMQ
+3 FOR I=1:1:$LENGTH(ORNMBR,",")
SET NMBR=$PIECE(ORNMBR,",",I)
IF NMBR
SET X=X_$SELECT($LENGTH(X):";",1:"")_+$PIECE($GET(^TMP("OR",$JOB,ORTAB,"IDX",NMBR)),U)
+4 ; builds ORFLG(GMRCIEN)=<menu>
if '$LENGTH(X)
GOTO SMQ
DO CPRS^GMRCACTM(X)
+5 SET I=0
FOR
SET I=$ORDER(ORFLG(I))
if I'>0
QUIT
IF ORFLG(I)>1
SET Y=1
QUIT
SMQ QUIT Y
