source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCA1.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1GMRCA1 ;SLC/DLT,DCM - Actions taken from Review Screens ; 7/11/03 14:05
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,18,35**;DEC 27, 1997
3 ; Patch 18 addS the option to Edit/Resubmit a canceled consult
4 ; This routine invokes IA #867,#2424
5 ;
6DC(GMRCO,GMRCA) ;Discontinue/Cancel(Deny) logic
7 ;GMRCO = File 123 IEN of consult
8 ;GMRCA = Action to take: 6=DISCONTINUED, 19=CANCELLED
9 ;GMRCOM=comments array
10 I '$G(GMRCA) D Q
11 . S GMRCMSG="This Action not defined!"
12 . D EXAC^GMRCADC(GMRCMSG)
13 . D END
14 . S GMRCQUT=1
15 K GMRCQUT,GMRCQIT
16 D DC^GMRCADC(GMRCO,GMRCA)
17 D END
18 Q
19 ;
20COMMENT(GMRCO) ;Add a comment without changing the status
21 N GMRCA,GMRCLCK
22 K GMRCQUT,GMRCQIT
23 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
24 I '+$G(GMRCO) D END S GMRCQUT=1 Q
25 I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
26 S GMRCLCK=1
27 D COMMENT^GMRCACMT(+GMRCO)
28 D END
29 Q
30 ;
31EDTSUB(GMRCO) ;Patch 18 Edit/Resubmit a canceled consult
32 N GMRCA,GMRCLCK,GMRCDFN,GMRCMSG
33 K GMRCQUT,GMRCQIT
34 S XQORM("M")=3
35 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
36 I '+$G(GMRCO) D END S GMRCQUT=1 Q
37 ;
38 ; Check to see if Provider or Update user is doing Edit/Resubmit
39 I '$$VALPROV^GMRCEDIT(GMRCO) D
40 .S GMRCMSG="0^You are not the provider of this Consult or a Update User"
41 I $P(^GMR(123,GMRCO,0),"^",12)'=13 D ; If not a canceled Consult
42 . S GMRCMSG="0^This consult is no longer editable."
43 I $D(GMRCMSG) D EXAC^GMRCADC($P(GMRCMSG,"^",2)) D END S GMRCQUT=1 Q
44 I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
45 S GMRCLCK=1
46 S GMRCDFN=$P(^GMR(123,GMRCO,0),"^",2) ; Get patient DFN
47 I $D(GMRCQUT) Q
48 D EN^GMRCEDIT(GMRCO,","_+GMRCDFN) ; Bring up Edit & Resubmit screen.
49 D END
50 Q
51 ;
52RC(GMRCO,GMRCSCH) ;Service tracking request received or scheduled
53 ; GMRCSCH=1 - schedule action
54 K GMRCQUT,GMRCQIT,GMRCSEL,GMRCAGN
55 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
56 I '+$G(GMRCO) D END S GMRCQUT=1 Q
57 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
58 . N DIR
59 . W !,"The requesting facility may not take this action on an "
60 . W "inter-facility consult."
61 . S DIR(0)="E" D ^DIR
62 . D END
63 . S GMRCQUT=1
64 I '$$LOCK(GMRCO) D END S GMRCQUT=1 Q
65 ;
66 N GMRCDA,GMRCIFN,GMRCLCK,GMRCAD
67 S GMRCLCK=1
68 S GMRC(0)=^GMR(123,GMRCO,0)
69 S DFN=$P(GMRC(0),"^",2)
70 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
71 .S GMRCMSG="This consult has already been "_$S($P(GMRC(0),"^",12)=2:"Completed",$P(^(0),"^",12)=13:"Cancelled",1:"Discontinued")_"."
72 .S GMRCMSG(1)=" This action may not be taken now."
73 .D EXAC^GMRCADC(GMRCMSG)
74 .K GMRCMSG
75 .Q
76 ;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
77 I '$G(GMRCSCH),$P(GMRC(0),"^",12)'=5 D Q
78 . S GMRCMSG="The receive action may only be taken when the consult"
79 . S GMRCMSG=GMRCMSG_" has a pending status."
80 . D EXAC^GMRCADC(GMRCMSG),END
81 . S GMRCQUT=1
82 I $G(GMRCSCH),"56"'[$P(GMRC(0),"^",12) D Q
83 . S GMRCMSG="This consult may not be scheduled with the current status"
84 . D EXAC^GMRCADC(GMRCMSG),END
85 . S GMRCQUT=1
86 ;
87 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
88 N GETPROV
89 S GETPROV=$S($G(GMRCSCH):"Who scheduled it?",1:"Who received it?")
90 D GETPROV^GMRCAU K GETPROV I $D(GMRCQIT) D END S GMRCQIT="Q",GMRCQUT=1 Q
91 I '$G(GMRCSCH) S GMRCAD=$$GETDT^GMRCUTL1("Date/Time Actually Received")
92 I $G(GMRCSCH) S GMRCAD=$$NOW^XLFDT
93 I GMRCAD="^" D Q
94 . W !,$C(7) D EXAC^GMRCADC("Consult not updated with Received action.")
95 . D END
96 . S GMRCQUT=1
97 ;The activity date is stored in GMRCAD
98 I '$G(GMRCSCH) D
99 . S GMRCA=21 ;for "Received"
100 . I $P(GMRC(0),"^",12)=5 S GMRCSTS=6,$P(GMRC(0),"^",12)=GMRCSTS
101 . E S GMRCSTS=$P(GMRC(0),"^",12)
102 I $G(GMRCSCH) S GMRCA=8,GMRCSTS=8
103 D STATUS^GMRCP
104 S GMRCOM=1 D AUDIT^GMRCP
105 D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCWARD),"SC",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
106 I $G(GMRCSCH),$P(GMRCOM,U,2)=1 D
107 . N TXT S TXT="Scheduled Consult: "
108 . D PROCALRT^GMRCACMT(TXT,"",20,GMRCO)
109 D END
110 Q
111 ;
112RT(GMRCO) ;Results Display logic
113 K GMRCQUT,GMRCQIT
114 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
115 I '+$G(GMRCO) D END S GMRCQUT=1 Q
116 D RT^GMRCART(GMRCO)
117 D END
118 Q
119 ;
120PS(GMRCO) ;Print Service Copy (CPRS entry point)
121 K GMRCQUT,GMRCQIT,GMRCSEL
122 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
123 I '+$G(GMRCO) D END S GMRCQUT=1 Q
124 S GMRC(0)=^GMR(123,GMRCO,0)
125 D EN^GMRCP5(GMRCO)
126 D END
127 Q
128 ;
129END ;kill off variables and exit
130 I $G(GMRCLCK) D UNLOCK(GMRCO)
131 I '$D(GMRC("NMBR")) K GMRCSEL,GMRCO
132 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
133 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
134 K DTOUT,DIROUT,DUOUT
135 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
136 Q
137LOCK(GMRCIFN) ;;lock a consult record using OE/RR order number
138 N GMRCORD,GMRCLOCK
139 S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD 1
140 S GMRCLOCK=$$LOCK1^ORX2(GMRCORD) I +GMRCLOCK Q 1
141 ;Q:$G(GMRCGUI)
142 D EXAC^GMRCADC($P(GMRCLOCK,U,2))
143 Q 0
144UNLOCK(GMRCIFN) ;unlock a consult record using OE/RR order number
145 N GMRCORD
146 S GMRCORD=$P($G(^GMR(123,GMRCIFN,0)),U,3) Q:'GMRCORD
147 D UNLK1^ORX2(GMRCORD)
148 Q
Note: See TracBrowser for help on using the repository browser.