source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCAAC.m@ 1444

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1GMRCAAC ;SLC/DLT - Administrative Complete action consult logic ;7/16/98 01:47
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,53**;DEC 27, 1997;Build 3
3COMP(GMRCO) ;Clerk action to Complete an order
4 ;GMRCO is the selected consult
5 K GMRCQUT,GMRCQIT
6 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) D END Q
7 I '+$G(GMRCO) D END S GMRCQUT=1 Q
8 ;
9 N GMRC,GMRCSTS,GMRCQUT
10 S GMRC(0)=$G(^GMR(123,+GMRCO,0)) Q:GMRC(0)=""
11 ;
12 ;Completion action restricted if status is 1,2,or 13
13 S GMRCSTS=$P(GMRC(0),"^",12)
14 I $S(GMRCSTS<3:1,GMRCSTS=13:1,1:0) D Q
15 . N GMRCMSG
16 . S GMRCMSG="This order has already been "_$S(GMRCSTS=1:"discontinued",GMRCSTS=2:"completed",1:"cancelled")_"!"
17 . D EXAC^GMRCADC(GMRCMSG)
18 . S GMRCQUT=1
19 . D END
20 ;
21 ;Get the provider, activity date, and significant findings
22 N DFN,ORIFN,ORGY,GMRCSF,GMRCSTS,GMRCA,GMRCDR,GMRCORNP,GMRCAD,GMRCADUZ
23 S ORGY="",(GMRCIFN,ORIFN)=$P(GMRC(0),"^",3),GMRCORVP=$P(GMRC(0),"^",2)_";DPT("
24 S DFN=+GMRCORVP
25 N GETPROV D GETPROV^GMRCAU I $G(GMRCQIT)="Q" D END Q
26 S GMRCAD=$$GETDT^GMRCUTL1 I GMRCAD="^" S GMRCQIT="Q" D END Q
27 S GMRCSFO=$P(GMRC(0),"^",19)
28 S GMRCSF=$$GETSIGF^GMRCASF(GMRCSFO) I GMRCSF=0 D END Q
29 ;
30 ;Update the Activity Log for an audit trail
31 S GMRCSTS=2,GMRCA=10
32 N GMRCQUIT S GMRCOM=1 D AUDIT^GMRCP I +$G(GMRCQUIT)=1 Q
33 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG) Q
34 ;Update status, last action and significant findings
35 S GMRCDR="8////^S X=GMRCSTS;9////^S X=GMRCA;15////^S X=GMRCSF"
36 D STATUS^GMRCP
37 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D Q
38 . N DA,DIK
39 . D EXAC^GMRCADC(GMRCMSG)
40 . S DA=$O(^GMR(123,+GMRCO,40,"A"),-1),DA(1)=+GMRCO,DIK="^GMR(123,"_DA(1)_",40," D ^DIK K DIK
41 ;
42 D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),"RE",GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
43 S GMRCADUZ=""
44 I $P(^GMR(123,GMRCO,0),"^",14) S GMRCADUZ($P(^(0),"^",14))=""
45 S GMRCORTX="Completed Consult "_$$ORTX^GMRCAU(GMRCO)_$S(GMRCSF="Y":" with Sig Findings",GMRCSF="N":" with no Sig Findings",1:"")
46 D MSG^GMRCP($P(^GMR(123,GMRCO,0),"^",2),GMRCORTX,+GMRCO,23,.GMRCADUZ,0)
47 Q
48 ;
49NOUPD ;Exit without making an update
50 S GMRCMSG="Completion activity ignored."
51 D EXAC^GMRCADC(GMRCMSG)
52 Q
53END K DUOUT,X,Y,GMRCPL,GMRCPLI,GMRCURG,GMRCURGI,GMRCPRI,XQORM
54 I '$D(GMRCNM) K GMRCVP
55 K GMRCDT,GMRCAD,GMRCL,GMRCTYPE
56 I '$D(GMRCO) S (GMRCO,ORIFN)=""
57 K GMRCIFN,GMRCMSG,GMRCORTX,GMRCSA,GMRCSTS,GMRCADUZ,STS
58 Q
Note: See TracBrowser for help on using the repository browser.