source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCAR.m@ 1556

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
3AR ;Associate results with request
4 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
5 I '$D(GMRCSEL) D SEL^GMRCA2 I $D(DTOUT)!$D(DIROUT) S GMRCQIT="" Q
6 I 'GMRCSEL G END
7 S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0)),GMRC(0)=^GMR(123,GMRCO,0)
8 I $P(GMRC(0),"^",12)=1 W !!,"THIS ORDER HAS BEEN DISCONTINUED, PLEASE SELECT OR ADD ANOTHER ORDER!",!! G END
9 S GMRCQIT="" Q
10ARMED ;Entry to associate results with a consult/request
11 N GMRCQIT,GMRCQUT,GMRCPROC,GMRCSR,MCROOT,MCFILE,Y
12 I '$$VERSION^XPDUTL("MC") D Q
13 . N GMRCMSG
14 . S GMRCMSG="Medicine Package Not Installed. Can't Associate Results."
15 . D EXAC^GMRCADC(GMRCMSG)
16 I $$VERSION^XPDUTL("MC")'>2.0 D Q
17 . N GMRCMSG
18 . S GMRCMSG="**Version 2.2 of Medicine required to associate results with Consults**"
19 . D EXAC^GMRCADC(GMRCMSG)
20 . S GMRCQUT=1
21 I $D(XQY0),$E(XQY0,1,2)="MC" G AR
22 I '$D(GMRCO) D SEL^GMRCA2 I 'GMRCSEL G END
23 I $D(VALM) D FULL^VALM1
24 I '$D(GMRCO) S GMRCO=$O(^TMP("GMRCR",$J,"CS","AD",GMRCSEL,GMRCSEL,0))
25 S GMRC(0)=^GMR(123,GMRCO,0)
26 S GMRCPROC=$P(GMRC(0),"^",8)
27 I GMRCPROC="" D G END
28 . S GMRCMSG="No Procedure was ordered - Cannot Associate Results."
29 . D EXAC^GMRCADC(GMRCMSG) S GMRCQIT=1
30 I '$P(^GMR(123.3,+GMRCPROC,0),U,5) D I $G(GMRCQIT)=1 G END
31 . D EXAC^GMRCADC("This procedure not configured for Medicine Resulting")
32 . S GMRCQIT=1
33 I $P(GMRC(0),"^",12)=1 D G END
34 . S GMRCMSG="THIS ORDER HAS BEEN DISCONTINUED!"
35 . D EXAC^GMRCADC(GMRCMSG) S GMRCQUT=1
36 I +$P(GMRC(0),"^",15),$P(GMRC(0),U,15)["MCAR" D
37 . S GMRCSR=$P(GMRC(0),"^",15)
38 . S GMRCSR=U_$P(GMRCSR,";",2)_$P(GMRCSR,";")_",0)"
39 . I '$D(@GMRCSR) D I $G(GMRCQIT)=1 Q
40 .. S GMRCMSG="This request is currently associated with results "
41 .. S GMRCMSG=GMRCMSG_"no longer available" D EXAC^GMRCADC(GMRCMSG),END
42 .. S GMRCQIT=1
43 .S X=$P(@GMRCSR,"^",1) D REGDTM^GMRCU S X1=X
44 .S X=$P(^GMR(123,GMRCO,0),"^",7) D REGDTM^GMRCU
45 .W !," Results entered on "_X1_" are associated "
46 .W !," with this request ordered on "_X
47 . S DIR(0)="YA",DIR("A")="Would you like to continue? "
48 . S DIR("B")="No" D ^DIR I Y<1 S GMRCQIT=1 Q
49 . Q
50 I $G(GMRCQIT)=1 Q
51 S MCROOT=$$GET1^DIQ(697.2,+$P(^GMR(123.3,+GMRCPROC,0),U,5),1)
52 D RESULTS^GMRCMED(MCROOT,$P(^GMR(123,+GMRCO,0),U,2))
53 I $D(^TMP("GMRCR",$J,"DT")) D EN^GMRCMER S VALMBCK="R",GMRCQIT=1
54 I '$D(^TMP("GMRCR",$J,"DT"))&'($G(GMRCQIT)) D
55 . N MSG
56 . S MSG="No results are available to associate with this request."
57 . D EXAC^GMRCADC(MSG)
58 Q
59LKUP ;look up on procedure file using "C" cross-reference
60 N Y,DIC
61 S GMRCDIC="^"_GMRCGL_",""C"","_DFN_")" I '$D(@GMRCDIC) S GMRCMSG="No "_GMRCPRNM_" results available for "_$P(^DPT(DFN,0),"^") D EXAC^GMRCADC(GMRCMSG) G END
62 S DIC="^"_GMRCGL_",",DIC(0)="XEZ",D="C",X=$P(^DPT(DFN,0),"^"),DIC("S")="I $P(^(0),U,2)=DFN" W !,"Results for "_$P(^DPT(DFN,0),"^")
63 D MIX^DIC1 G:+Y<0 END
64 S GMRCSR=+Y_";"_GMRCGL_",",GMRCSRDT=Y(0,0)
65 N GMRCEND S GMRCEND=0 W ! S DIR(0)="Y",DIR("A")="Do you want to review these results first",DIR("B")="Y" D ^DIR K DIR I Y D G:GMRCEND END
66 .W @IOF S GMRCSRS=GMRCSR D AREN^GMRCSLM3(GMRCO,GMRCSR),EN^GMRCMER S GMRCSR=GMRCSRS
67 .I GMRCCT=1 S GMRCEND=1 Q
68 .N DIR,DIROUT,DTOUT,DUOUT
69 .W !! S DIR(0)="Y",DIR("A")="Are these the right results to be associated with the selected request",DIR("B")="N" D ^DIR K DIR S:$D(DIROUT)!$D(DTOUT)!(X="^") GMRCEND=1
70 .I Y=0 K GMRCSR S GMRCEND=1
71 I GMRCEND K GMRCEND G END
72 I '$D(GMRCSR) K GMRCEND W ! G LKUP
73 I '+GMRCSR G END
74ORSTS ;Check if status needs update to complete
75 N ORSTS
76 I $P(GMRC(0),"^",12)=2 W !,"This request is already completed, no updating performed for this request",!,"Press the <ENTER> key to EXIT " R X:DTIME G END
77 W ! S DIR(0)="Y",DIR("A")="Shall I update the order status to complete",DIR("B")="N",DIR("?")="Type 'Y' for 'YES' or 'N' for 'NO' and press <ENTER> key." D ^DIR K DIR I $D(DTOUT)!$D(DIROUT)!$D(DUOUT) G END
78 S ORSTS=$S(Y:2,1:9)
79 I $P(^GMR(123,GMRCO,0),"^",12)=ORSTS&(+$P(^GMR(123,GMRCO,0),"^",15)) G END
80 S GETPROV="Clinician responsible for results" D GETPROV^GMRCAU I '$D(GMRCORNP) S GMRCQIT="" G END
81 S GMRCSVSS=GMRCSVCN D RESULT^GMRCR S GMRCSS=GMRCSVSS K GMRCSVSS,ORIFN
82 S GMRCVP=$O(^ORD(101,"B","GMRCR "_GMRCPROC,0)) I GMRCVP]"" S GMRCVP=GMRCVP_";ORD(101," D AD^GMRCSLM1,INIT^GMRCSLM
83END ;
84 K ORIFN,GMRCO,GMRCEND,GMRCGL,GMRCDIC,GMRCMSG,GMRCVP,DIC,D,GMRCSR,GMRCSRDT,GMRCSRS,GMRCTM,GMRCBM,X,X1,GETPROV
85 K GMRCO,GMRC(0),GMRCSR,MCFILE,MCPROC,GMRCPROC,GMRCPRNM
86 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
87 Q
Note: See TracBrowser for help on using the repository browser.