GMRCA1 ;SLC/DLT,DCM - Actions taken from Review Screens ; 7/11/03 14:05
;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,18,35**;DEC 27, 1997
; Patch 18 addS the option to Edit/Resubmit a canceled consult
; This routine invokes IA #867,#2424
;
DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
;GMRCO = File 123 IEN of consult
;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
;GMRCOM=comments array
I '$G(GMRCA) D Q
. S GMRCMSG="This Action not defined!"
. D EXAC^GMRCADC(GMRCMSG)
. D END
. S GMRCQUT=1
K GMRCQUT,GMRCQIT
D DC^GMRCADC(GMRCO,GMRCA)
D END
Q
;
N GMRCA,GMRCLCK
K GMRCQUT,GMRCQIT
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
S GMRCLCK=1
D COMMENT^GMRCACMT(+GMRCO)
D END
Q
;
EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
N GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
K GMRCQUT,GMRCQIT
S XQORM("M")=3
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
;
; Check to see if Provider or Update user is doing Edit/Resubmit
I '$$VALPROV^GMRCEDIT(GMRCO) D
.S GMRCMSG="0^You are not the provider of this Consult or a Update User"
I $P(^GMR(123,GMRCO,0),"^",12)'=13 D ; If not a canceled Consult
. S GMRCMSG="0^This consult is no longer editable."
I $D(GMRCMSG) D EXAC^GMRCADC($P(GMRCMSG,"^",2)) D END S GMRCQUT=1 Q
I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
S GMRCLCK=1
S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2) ; Get patient DFN
I $D(GMRCQUT) Q
D EN^GMRCEDIT(GMRCO,","_+GMRCDFN) ; Bring up Edit & Resubmit screen.
D END
Q
;
RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
; GMRCSCH=1 - schedule action
K GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
. N DIR
. W !,"The requesting facility may not take this action on an "
. W "inter-facility consult."
. S DIR(0)="E" D ^DIR
. D END
. S GMRCQUT=1
I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
;
N GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
S GMRCLCK=1
S GMRC(0)=^GMR(123,GMRCO,0)
S DFN=$P(GMRC(0),"^",2)
I $S($P(GMRC(0),"^",12)=2:1,$P(^(0),"^",12)=1:1,$P(^(0),"^",12)=13:1,1:0) D S GMRCQUT=1 D END Q
.S GMRCMSG="This consult has already been "_$S($P(GMRC(0),"^",12)=2:"Completed",$P(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
.S GMRCMSG(1)=" This action may not be taken now."
.D EXAC^GMRCADC(GMRCMSG)
.K GMRCMSG
.Q
;I $P(^GMR(123.5,$P(GMRC(0),"^",5),0),"^",2)=9 S GMRCMSG=$P(^(0),"^",1)_" is an INACTIVE service. No Receive action is possible",GMRCMSG(1)="for this consult on this Service!" D EXAC^GMRCADC(.GMRCMSG),END S GMRCQUT=1 Q
I '$G(GMRCSCH),$P(GMRC(0),"^",12)'=5 D Q
. S GMRCMSG="The receive action may only be taken when the consult"
. S GMRCMSG=GMRCMSG_" has a pending status."
. D EXAC^GMRCADC(GMRCMSG),END
. S GMRCQUT=1
I $G(GMRCSCH),"56"'[$P(GMRC(0),"^",12) D Q
. S GMRCMSG="This consult may not be scheduled with the current status"
. D EXAC^GMRCADC(GMRCMSG),END
. S GMRCQUT=1
;
I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
N GETPROV
S GETPROV=$S($G(GMRCSCH):"Who scheduled it?",1:"Who received it?")
D GETPROV^GMRCAU K GETPROV I $D(GMRCQIT) D END S GMRCQIT="Q",GMRCQUT=1 Q
I '$G(GMRCSCH) S GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
I $G(GMRCSCH) S GMRCAD=$$NOW^XLFDT
I GMRCAD="^" D Q
. W !,$C(7) D EXAC^GMRCADC("Consult not updated with Received action.")
. D END
. S GMRCQUT=1
;The activity date is stored in GMRCAD
I '$G(GMRCSCH) D
. S GMRCA=21 ;for "Received"
. I $P(GMRC(0),"^",12)=5 S GMRCSTS=6,$P(GMRC(0),"^",12)=GMRCSTS
. E S GMRCSTS=$P(GMRC(0),"^",12)
I $G(GMRCSCH) S GMRCA=8,GMRCSTS=8
D STATUS^GMRCP
S GMRCOM=1 D AUDIT^GMRCP
D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCWARD),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
I $G(GMRCSCH),$P(GMRCOM,U,2)=1 D
. N TXT S TXT="Scheduled Consult: "
. D PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
D END
Q
;
RT(GMRCO) ;Results Display logic
K GMRCQUT,GMRCQIT
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
D RT^GMRCART(GMRCO)
D END
Q
;
PS(GMRCO) ;Print Service Copy (CPRS entry point)
K GMRCQUT,GMRCQIT,GMRCSEL
I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
I '+$G(GMRCO) D END S GMRCQUT=1 Q
S GMRC(0)=^GMR(123,GMRCO,0)
D EN^GMRCP5(GMRCO)
D END
Q
;
END ;kill off variables and exit
I $G(GMRCLCK) D UNLOCK(GMRCO)
I '$D(GMRC("NMBR")) K GMRCSEL,GMRCO
K GMRC(0),GMRCA,GMRCACTM,GMRCAGN,GMRCDFN,GMRCENTR,GMRCFL,GMRCIEN,GMRCMSG,GMRCOM,GMRCO,GMRCORFN,GMRCORN,GMRCORTX,GMRCRTFL,GMRCSEL,GMRCSTS,GMRCTRLC,GMRCEND,GMRCSA,GMRCSR,GMRCBM,GMRCTM,GMRCADUZ,ORIFN,OREND,SF,STS
I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
K DTOUT,DIROUT,DUOUT
S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
Q
LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
N GMRCORD,GMRCLOCK
S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD 1
S GMRCLOCK=$$LOCK1^ORX2(GMRCORD) I +GMRCLOCK Q 1
;Q:$G(GMRCGUI)
D EXAC^GMRCADC($P(GMRCLOCK,U,2))
Q 0
UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
N GMRCORD
S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD
D UNLK1^ORX2(GMRCORD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCA1 5448 printed Sep 23, 2025@19:20:53 Page 2
GMRCA1 ;SLC/DLT,DCM - Actions taken from Review Screens ; 7/11/03 14:05
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,18,35**;DEC 27, 1997
+2 ; Patch 18 addS the option to Edit/Resubmit a canceled consult
+3 ; This routine invokes IA #867,#2424
+4 ;
DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
+1 ;GMRCO = File 123 IEN of consult
+2 ;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
+3 ;GMRCOM=comments array
+4 IF '$GET(GMRCA)
Begin DoDot:1
+5 SET GMRCMSG="This Action not defined!"
+6 DO EXAC^GMRCADC(GMRCMSG)
+7 DO END
+8 SET GMRCQUT=1
End DoDot:1
QUIT
+9 KILL GMRCQUT,GMRCQIT
+10 DO DC^GMRCADC(GMRCO,GMRCA)
+11 DO END
+12 QUIT
+13 ;
+1 NEW GMRCA,GMRCLCK
+2 KILL GMRCQUT,GMRCQIT
+3 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+4 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+5 IF '$$LOCK(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+6 SET GMRCLCK=1
+7 DO COMMENT^GMRCACMT(+GMRCO)
+8 DO END
+9 QUIT
+10 ;
EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
+1 NEW GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
+2 KILL GMRCQUT,GMRCQIT
+3 SET XQORM("M")=3
+4 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+5 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+6 ;
+7 ; Check to see if Provider or Update user is doing Edit/Resubmit
+8 IF '$$VALPROV^GMRCEDIT(GMRCO)
Begin DoDot:1
+9 SET GMRCMSG="0^You are not the provider of this Consult or a Update User"
End DoDot:1
+10 ; If not a canceled Consult
IF $PIECE(^GMR(123,GMRCO,0),"^",12)'=13
Begin DoDot:1
+11 SET GMRCMSG="0^This consult is no longer editable."
End DoDot:1
+12 IF $DATA(GMRCMSG)
DO EXAC^GMRCADC($PIECE(GMRCMSG,"^",2))
DO END
SET GMRCQUT=1
QUIT
+13 IF '$$LOCK(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+14 SET GMRCLCK=1
+15 ; Get patient DFN
SET GMRCDFN=$PIECE(^GMR(123,GMRCO,0),"^",2)
+16 IF $DATA(GMRCQUT)
QUIT
+17 ; Bring up Edit & Resubmit screen.
DO EN^GMRCEDIT(GMRCO,","_+GMRCDFN)
+18 DO END
+19 QUIT
+20 ;
RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
+1 ; GMRCSCH=1 - schedule action
+2 KILL GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
+3 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+4 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+5 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
Begin DoDot:1
+6 NEW DIR
+7 WRITE !,"The requesting facility may not take this action on an "
+8 WRITE "inter-facility consult."
+9 SET DIR(0)="E"
DO ^DIR
+10 DO END
+11 SET GMRCQUT=1
End DoDot:1
QUIT
+12 IF '$$LOCK(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+13 ;
+14 NEW GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
+15 SET GMRCLCK=1
+16 SET GMRC(0)=^GMR(123,GMRCO,0)
+17 SET DFN=$PIECE(GMRC(0),"^",2)
+18 IF $SELECT($PIECE(GMRC(0),"^",12)=2:1,$PIECE(^(0),"^",12)=1:1,$PIECE(^(0),"^",12)=13:1,1:0)
Begin DoDot:1
+19 SET GMRCMSG="This consult has already been "_$SELECT($PIECE(GMRC(0),"^",12)=2:"Completed",$PIECE(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
+20 SET GMRCMSG(1)=" This action may not be taken now."
+21 DO EXAC^GMRCADC(GMRCMSG)
+22 KILL GMRCMSG
+23 QUIT
End DoDot:1
SET GMRCQUT=1
DO END
QUIT
+24 ;I $P(^GMR(123.5,$P(GMRC(0),"^",5),0),"^",2)=9 S GMRCMSG=$P(^(0),"^",1)_" is an INACTIVE service. No Receive action is possible",GMRCMSG(1)="for this consult on this Service!" D EXAC^GMRCADC(.GMRCMSG),END S GMRCQUT=1 Q
+25 IF '$GET(GMRCSCH)
IF $PIECE(GMRC(0),"^",12)'=5
Begin DoDot:1
+26 SET GMRCMSG="The receive action may only be taken when the consult"
+27 SET GMRCMSG=GMRCMSG_" has a pending status."
+28 DO EXAC^GMRCADC(GMRCMSG)
DO END
+29 SET GMRCQUT=1
End DoDot:1
QUIT
+30 IF $GET(GMRCSCH)
IF "56"'[$PIECE(GMRC(0),"^",12)
Begin DoDot:1
+31 SET GMRCMSG="This consult may not be scheduled with the current status"
+32 DO EXAC^GMRCADC(GMRCMSG)
DO END
+33 SET GMRCQUT=1
End DoDot:1
QUIT
+34 ;
+35 IF $DATA(IOTM)
IF $DATA(IOBM)
IF $DATA(IOSTBM)
DO FULL^VALM1
+36 NEW GETPROV
+37 SET GETPROV=$SELECT($GET(GMRCSCH):"Who scheduled it?",1:"Who received it?")
+38 DO GETPROV^GMRCAU
KILL GETPROV
IF $DATA(GMRCQIT)
DO END
SET GMRCQIT="Q"
SET GMRCQUT=1
QUIT
+39 IF '$GET(GMRCSCH)
SET GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
+40 IF $GET(GMRCSCH)
SET GMRCAD=$$NOW^XLFDT
+41 IF GMRCAD="^"
Begin DoDot:1
+42 WRITE !,$CHAR(7)
DO EXAC^GMRCADC("Consult not updated with Received action.")
+43 DO END
+44 SET GMRCQUT=1
End DoDot:1
QUIT
+45 ;The activity date is stored in GMRCAD
+46 IF '$GET(GMRCSCH)
Begin DoDot:1
+47 ;for "Received"
SET GMRCA=21
+48 IF $PIECE(GMRC(0),"^",12)=5
SET GMRCSTS=6
SET $PIECE(GMRC(0),"^",12)=GMRCSTS
+49 IF '$TEST
SET GMRCSTS=$PIECE(GMRC(0),"^",12)
End DoDot:1
+50 IF $GET(GMRCSCH)
SET GMRCA=8
SET GMRCSTS=8
+51 DO STATUS^GMRCP
+52 SET GMRCOM=1
DO AUDIT^GMRCP
+53 DO EN^GMRCHL7(DFN,GMRCO,$GET(GMRCTYPE),$GET(GMRCWARD),"SC",GMRCORNP,$GET(GMRCVSIT),.GMRCOM,,$GET(GMRCAD))
+54 IF $GET(GMRCSCH)
IF $PIECE(GMRCOM,U,2)=1
Begin DoDot:1
+55 NEW TXT
SET TXT="Scheduled Consult: "
+56 DO PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
End DoDot:1
+57 DO END
+58 QUIT
+59 ;
RT(GMRCO) ;Results Display logic
+1 KILL GMRCQUT,GMRCQIT
+2 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+3 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+4 DO RT^GMRCART(GMRCO)
+5 DO END
+6 QUIT
+7 ;
PS(GMRCO) ;Print Service Copy (CPRS entry point)
+1 KILL GMRCQUT,GMRCQIT,GMRCSEL
+2 IF '+$GET(GMRCO)
DO SELECT^GMRCA2(.GMRCO)
IF $DATA(GMRCQUT)
DO END
QUIT
+3 IF '+$GET(GMRCO)
DO END
SET GMRCQUT=1
QUIT
+4 SET GMRC(0)=^GMR(123,GMRCO,0)
+5 DO EN^GMRCP5(GMRCO)
+6 DO END
+7 QUIT
+8 ;
END ;kill off variables and exit
+1 IF $GET(GMRCLCK)
DO UNLOCK(GMRCO)
+2 IF '$DATA(GMRC("NMBR"))
KILL GMRCSEL,GMRCO
+3 KILL GMRC(0),GMRCA,GMRCACTM,GMRCAGN,GMRCDFN,GMRCENTR,GMRCFL,GMRCIEN,GMRCMSG,GMRCOM,GMRCO,GMRCORFN,GMRCORN,GMRCORTX,GMRCRTFL,GMRCSEL,GMRCSTS,GMRCTRLC,GMRCEND,GMRCSA,GMRCSR,GMRCBM,GMRCTM,GMRCADUZ,ORIFN,OREND,SF,STS
+4 IF $DATA(DTOUT)!$DATA(DIROUT)
SET GMRCQIT=""
+5 KILL DTOUT,DIROUT,DUOUT
+6 if $DATA(^TMP("GMRC",$JOB,"CURRENT","MENU"))
SET XQORM("HIJACK")=^("MENU")
+7 QUIT
LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
+1 NEW GMRCORD,GMRCLOCK
+2 SET GMRCORD=$PIECE($GET(^GMR(123,GMRCIFN,0)),U,3)
if 'GMRCORD
QUIT 1
+3 SET GMRCLOCK=$$LOCK1^ORX2(GMRCORD)
IF +GMRCLOCK
QUIT 1
+4 ;Q:$G(GMRCGUI)
+5 DO EXAC^GMRCADC($PIECE(GMRCLOCK,U,2))
+6 QUIT 0
UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
+1 NEW GMRCORD
+2 SET GMRCORD=$PIECE($GET(^GMR(123,GMRCIFN,0)),U,3)
if 'GMRCORD
QUIT
+3 DO UNLK1^ORX2(GMRCORD)
+4 QUIT
