source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCADC.m@ 1211

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1GMRCADC ;SLC/DLT/DCM - DC taken from List Manager ; 7/11/05 1:40pm
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,10,12,35,39,47**;DEC 27, 1997
3EXAC(MSG) ;Exit message asking for user to press <ENTER>; EXAC=Exit Action
4 N ND,X
5 W $C(7),!,MSG I $O(MSG(0)) S ND=0 F S ND=$O(MSG(ND)) Q:ND="" D
6 . W !,MSG(ND)
7 W !,"Press <RETURN> to continue: " R X:DTIME W !!
8 Q
9DC(GMRCO,GMRCA) ;Discontinue a consult logic from DC^GMRCA1
10 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
11 N GMRCDA,GMRCACTM,GMRCADUZ,GMRCSERV,GMRCAD,GMRC
12 K GMRCQUT,GMRCQIT
13 I '+$G(GMRCO) D SELECT^GMRCA2(.GMRCO) I $D(GMRCQUT) Q
14 I '+$G(GMRCO) S GMRCQUT=1 Q
15 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D Q
16 . N DIR
17 . W !,"The requesting facility may not take this action on an "
18 . W "inter-facility consult."
19 . S DIR(0)="E" D ^DIR
20 . S GMRCQUT=1
21 I '$$LOCK^GMRCA1(GMRCO) S GMRCQUT=1 Q
22 ;
23 S GMRC(0)=^GMR(123,GMRCO,0),GMRCDA=GMRCO
24 S (GMRCDFN,DFN)=$P(GMRC(0),"^",2)
25 I $D(GMRCA),+GMRCA S GMRCACTM=$S(GMRCA=6:"Discontinued",GMRCA=19:"Cancelled",1:$P($G(^GMR(123.1,+GMRCA,0)),"^",1))
26 ;
27 D PROC I $D(GMRCQUT) D UNLOCK^GMRCA1(GMRCO) S GMRCQUT=1 Q
28 ;send 513 back to service printer if request DC'd or Cancelled
29 I GMRCA=6,$$DCPRNT^GMRCUTL1(+GMRCO,DUZ) D
30 . D PRNT^GMRCUTL1(+$P(GMRC(0),U,5),+GMRCO)
31 S GMRCTRLC=$S(GMRCA=19:"OC",1:"OD")
32 D EN^GMRCHL7(DFN,GMRCO,$G(GMRCTYPE),$G(GMRCRB),GMRCTRLC,GMRCORNP,$G(GMRCVSIT),.GMRCOM,,$G(GMRCAD))
33 D UNLOCK^GMRCA1(GMRCO)
34 Q
35 ;
36PROC ;Check validity of action and if valid process the discontinue action
37 N DIROUT,DTOUT,DUOUT,GMRCMSG,GMRCFL,GMRCACT
38 I $P(GMRC(0),"^",12)=1 S GMRCMSG="This consult has already been discontinued!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
39 I $P(GMRC(0),"^",12)=2 S GMRCMSG="This consult has already been completed!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
40 I $P(GMRC(0),"^",12)=9 S GMRCMSG="Action invalid. This consult has partial results!",GMRCMSG(1)="Remove the associated results and then discontinue." D EXAC(.GMRCMSG) S GMRCQUT=1 Q
41 I $P(GMRC(0),"^",12)=13 S GMRCMSG="This consult has already been cancelled!" D EXAC(GMRCMSG) S GMRCQUT=1 Q
42 ;
43 S GMRCORVP=GMRCDFN_";DPT("
44 N GETPROV
45FRGTPRV D GETPROV^GMRCAU I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) S GMRCQUT=1 Q
46 S GMRCACT=$$PROVIDER^XUSER(GMRCORNP) I $P(GMRCACT,U)'=1 D G FRGTPRV
47 .W !!,"***User account is TERMINATED please choose another responsible user.***"
48 S GMRCAD=$$GETDT^GMRCUTL1 ;Returns GMRCAD as the entered date
49 I GMRCAD="^" S GMRCQUT=1 Q
50 S GMRCSTS=$S(GMRCA=6:1,1:13),$P(GMRC(0),"^",12)=GMRCSTS
51 S GMRCOM=1
52 D STATUS^GMRCP
53 D AUDIT^GMRCP
54 ;
55 S GMRCORTX=$S($L($G(GMRCACTM)):GMRCACTM,+GMRCA:$P(^GMR(123.1,GMRCA,0),U,1),1:"ACTION UNKNOWN FOR")_" consult "_$$ORTX^GMRCAU(+GMRCO)
56 S GMRCADUZ="",GMRCFL=0
57 I +$P($G(^GMR(123,+GMRCO,0)),"^",14),+$P(^(0),"^",14)'=DUZ S GMRCADUZ($P(^(0),"^",14))=""
58 ;I +$P($G(^GMR(123,+GMRCO,0)),"^",14)=DUZ S GMRCFL=1
59 I GMRCA=6 S GMRCFL=$$DCNOTE(GMRCO,DUZ) ;check NOTIFY SERVICE ON DC
60 ;I GMRCA=19 S GMRCFL=1
61 ;send notification info to routine to be sent to OERR
62 N NOTYPE S NOTYPE=$S(GMRCA=6:23,1:30)
63 D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,NOTYPE,.GMRCADUZ,GMRCFL)
64 Q
65DCNOTE(IEN,USER) ;determine if service users receive alerts based on 1.04
66 N SERV,DCFLG
67 S SERV=$P(^GMR(123,IEN,0),U,5)
68 S DCFLG=$P($G(^GMR(123.5,SERV,1)),U,4)
69 I 'DCFLG Q 1
70 I DCFLG=2 Q 0
71 I DCFLG=1,'$$VALID^GMRCAU(SERV,IEN,USER) Q 1
72 Q 0
Note: See TracBrowser for help on using the repository browser.