Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCA1

GMRCA1.m

Go to the documentation of this file.
  1. 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
  1. ; Patch 18 addS the option to Edit/Resubmit a canceled consult
  1. ; This routine invokes IA #867,#2424
  1. ;
  1. DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
  1. ;GMRCO = File 123 IEN of consult
  1. ;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
  1. ;GMRCOM=comments array
  1. I '$G(GMRCA) D Q
  1. . S GMRCMSG="This Action not defined!"
  1. . D EXAC^GMRCADC(GMRCMSG)
  1. . D END
  1. . S GMRCQUT=1
  1. K GMRCQUT,GMRCQIT
  1. D DC^GMRCADC(GMRCO,GMRCA)
  1. D END
  1. Q
  1. ;
  1. COMMENT(GMRCO) ;Add a comment without changing the status
  1. N GMRCA,GMRCLCK
  1. K GMRCQUT,GMRCQIT
  1. I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
  1. I '+$G(GMRCO) D END S GMRCQUT=1 Q
  1. I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
  1. S GMRCLCK=1
  1. D COMMENT^GMRCACMT(+GMRCO)
  1. D END
  1. Q
  1. ;
  1. EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
  1. N GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
  1. K GMRCQUT,GMRCQIT
  1. S XQORM("M")=3
  1. I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
  1. I '+$G(GMRCO) D END S GMRCQUT=1 Q
  1. ;
  1. ; Check to see if Provider or Update user is doing Edit/Resubmit
  1. I '$$VALPROV^GMRCEDIT(GMRCO) D
  1. .S GMRCMSG="0^You are not the provider of this Consult or a Update User"
  1. I $P(^GMR(123,GMRCO,0),"^",12)'=13 D ; If not a canceled Consult
  1. . S GMRCMSG="0^This consult is no longer editable."
  1. I $D(GMRCMSG) D EXAC^GMRCADC($P(GMRCMSG,"^",2)) D END S GMRCQUT=1 Q
  1. I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
  1. S GMRCLCK=1
  1. S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2) ; Get patient DFN
  1. I $D(GMRCQUT) Q
  1. D EN^GMRCEDIT(GMRCO,","_+GMRCDFN) ; Bring up Edit & Resubmit screen.
  1. D END
  1. Q
  1. ;
  1. RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
  1. ; GMRCSCH=1 - schedule action
  1. K GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
  1. I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
  1. I '+$G(GMRCO) D END S GMRCQUT=1 Q
  1. I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
  1. . N DIR
  1. . W !,"The requesting facility may not take this action on an "
  1. . W "inter-facility consult."
  1. . S DIR(0)="E" D ^DIR
  1. . D END
  1. . S GMRCQUT=1
  1. I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
  1. ;
  1. N GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
  1. S GMRCLCK=1
  1. S GMRC(0)=^GMR(123,GMRCO,0)
  1. S DFN=$P(GMRC(0),"^",2)
  1. 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
  1. .S GMRCMSG="This consult has already been "_$S($P(GMRC(0),"^",12)=2:"Completed",$P(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
  1. .S GMRCMSG(1)=" This action may not be taken now."
  1. .D EXAC^GMRCADC(GMRCMSG)
  1. .K GMRCMSG
  1. .Q
  1. ;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
  1. I '$G(GMRCSCH),$P(GMRC(0),"^",12)'=5 D Q
  1. . S GMRCMSG="The receive action may only be taken when the consult"
  1. . S GMRCMSG=GMRCMSG_" has a pending status."
  1. . D EXAC^GMRCADC(GMRCMSG),END
  1. . S GMRCQUT=1
  1. I $G(GMRCSCH),"56"'[$P(GMRC(0),"^",12) D Q
  1. . S GMRCMSG="This consult may not be scheduled with the current status"
  1. . D EXAC^GMRCADC(GMRCMSG),END
  1. . S GMRCQUT=1
  1. ;
  1. I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
  1. N GETPROV
  1. S GETPROV=$S($G(GMRCSCH):"Who scheduled it?",1:"Who received it?")
  1. D GETPROV^GMRCAU K GETPROV I $D(GMRCQIT) D END S GMRCQIT="Q",GMRCQUT=1 Q
  1. I '$G(GMRCSCH) S GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
  1. I $G(GMRCSCH) S GMRCAD=$$NOW^XLFDT
  1. I GMRCAD="^" D Q
  1. . W !,$C(7) D EXAC^GMRCADC("Consult not updated with Received action.")
  1. . D END
  1. . S GMRCQUT=1
  1. ;The activity date is stored in GMRCAD
  1. I '$G(GMRCSCH) D
  1. . S GMRCA=21 ;for "Received"
  1. . I $P(GMRC(0),"^",12)=5 S GMRCSTS=6,$P(GMRC(0),"^",12)=GMRCSTS
  1. . E S GMRCSTS=$P(GMRC(0),"^",12)
  1. I $G(GMRCSCH) S GMRCA=8,GMRCSTS=8
  1. D STATUS^GMRCP
  1. S GMRCOM=1 D AUDIT^GMRCP
  1. D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCWARD),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
  1. I $G(GMRCSCH),$P(GMRCOM,U,2)=1 D
  1. . N TXT S TXT="Scheduled Consult: "
  1. . D PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
  1. D END
  1. Q
  1. ;
  1. RT(GMRCO) ;Results Display logic
  1. K GMRCQUT,GMRCQIT
  1. I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
  1. I '+$G(GMRCO) D END S GMRCQUT=1 Q
  1. D RT^GMRCART(GMRCO)
  1. D END
  1. Q
  1. ;
  1. PS(GMRCO) ;Print Service Copy (CPRS entry point)
  1. K GMRCQUT,GMRCQIT,GMRCSEL
  1. I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
  1. I '+$G(GMRCO) D END S GMRCQUT=1 Q
  1. S GMRC(0)=^GMR(123,GMRCO,0)
  1. D EN^GMRCP5(GMRCO)
  1. D END
  1. Q
  1. ;
  1. END ;kill off variables and exit
  1. I $G(GMRCLCK) D UNLOCK(GMRCO)
  1. I '$D(GMRC("NMBR")) K GMRCSEL,GMRCO
  1. 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
  1. I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
  1. K DTOUT,DIROUT,DUOUT
  1. S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. Q
  1. LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
  1. N GMRCORD,GMRCLOCK
  1. S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD 1
  1. S GMRCLOCK=$$LOCK1^ORX2(GMRCORD) I +GMRCLOCK Q 1
  1. ;Q:$G(GMRCGUI)
  1. D EXAC^GMRCADC($P(GMRCLOCK,U,2))
  1. Q 0
  1. UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
  1. N GMRCORD
  1. S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD
  1. D UNLK1^ORX2(GMRCORD)
  1. Q