| 1 | GMRCAR ;SLC/DLT,JFR - Associate Results ;7/21/00 12:20
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**1,15**;DEC 27, 1997
|
|---|
| 3 | AR ;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
|
|---|
| 10 | ARMED ;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
|
|---|
| 59 | LKUP ;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
|
|---|
| 74 | ORSTS ;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
|
|---|
| 83 | END ;
|
|---|
| 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
|
|---|
